Ignore:
Timestamp:
Jul 28, 2000, 2:38:04 PM (24 years ago)
Author:
lmdzadmin
Message:

Mise au point de l'interface en force, ca tourne sur un pas de temps
LF

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

Legend:

Unmodified
Added
Removed

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

    r99 r112  
    1010      !
    1111      !
    12       INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2,
    13      .KLON=KFDIA-KIDIA+1,KLEV=llm
     12c      INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2,
     13c     .KLON=KFDIA-KIDIA+1,KLEV=llm
    1414      !
    1515#include "comgeom2.h"
    1616#include "comvert.h"
    1717#include "comconst.h"
     18#include "indicesol.h"
     19#include "dimphy.h"
     20#include "dimsoil.h"
    1821      !
    1922      REAL :: latfi(klon), lonfi(klon)
    … …  
    2528      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
    2629      REAL :: q3d(iip1, jjp1, llm,nqmx), qsat(iip1, jjp1, llm)
    27       REAL :: tsol(klon), qsol(klon), sn(klon), radsol(klon)
    28       REAL :: deltat(klon), rugmer(klon), agesno(klon)
     30      REAL :: tsol(klon), qsol(klon), sn(klon)
     31      REAL :: tsolsrf(klon,nbsrf), qsolsrf(klon,nbsrf),snsrf(klon,nbsrf)
     32      REAL :: albe(klon,nbsrf), evap(klon,nbsrf)
     33      REAL :: tsoil(klon,nsoilmx,nbsrf)
     34      REAL :: radsol(klon),rain_fall(klon), snow_fall(klon)
     35      REAL :: solsw(klon), sollw(klon)
     36      REAL :: deltat(klon), frugs(klon,nbsrf), agesno(klon),rugmer(klon)
    2937      REAL :: zmea(iip1*jjp1), zstd(iip1*jjp1)
    3038      REAL :: zsig(iip1*jjp1), zgam(iip1*jjp1), zthe(iip1*jjp1)
    3139      REAL :: zpic(iip1*jjp1), zval(iip1*jjp1), rugsrel(iip1*jjp1)
    3240      REAL :: qd(iip1, jjp1, llm)
    33       !
     41      REAL :: pctsrf(klon, nbsrf)
     42      REAL :: t_ancien(klon,klev), q_ancien(klon,klev)      !
     43      ! declarations pour lecture glace de mer
     44      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
     45      INTEGER :: itaul(1), fid
     46      REAL :: lev(1), date, dt
     47      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
     48      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
     49      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
     50      REAL :: flic_tmp(iip1, jjp1)
     51      REAL :: champint(iim, jjp1)
     52      !
     53
    3454      CHARACTER*80 :: varname
    3555      !
    36       INTEGER :: i,j, ig, l
     56      INTEGER :: i,j, ig, l, ji
    3757      REAL :: xpi
    3858      !
    … …  
    144164      !
    145165      !
     166
     167
     168C
     169C on initialise les sous surfaces
     170C
     171      pctsrf=0.
     172      !cree le masque a partir du fichier relief
     173      varname = 'zmasq'
     174      zmasq(:) = 0.
     175      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0)
     176      WHERE (zmasq(1 : klon) .LE. EPSFRA)
     177          zmasq(1 : klon) = 0.
     178      END WHERE
     179      WRITE(*,*)zmasq
     180
     181
     182
     183
    146184      varname = 'psol'
    147185      psol(:,:) = 0.0
    … …  
    227265      ! This line needs to be replaced by a call to restget to get the values in the restart file
    228266      tsol(:) = 0.0
    229       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0)
     267      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol,0.0)
    230268      !
    231269      WRITE(*,*) 'TSOL construit :'
    … …  
    234272      varname = 'qsol'
    235273      qsol(:) = 0.0
    236       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0)
     274      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol,0.0)
    237275      !
    238276      varname = 'snow'
    239277      sn(:) = 0.0
    240       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0)
     278      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn,0.0)
    241279      !
    242280      varname = 'rads'
    … …  
    278316      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0)
    279317      rugsrel(:) = 0.0
     318
     319
     320C
     321C lecture du fichier glace de terre pour fixer la fraction de terre
     322C et de glace de terre
     323C
     324      CALL flininfo("landiceref.nc", iml_lic, jml_lic,llm_tmp, ttm_tmp
     325     $    , fid)
     326      ALLOCATE(lat_lic(iml_lic, jml_lic), stat=iret)
     327      ALLOCATE(lon_lic(iml_lic, jml_lic), stat=iret)
     328      ALLOCATE(dlon_lic(iml_lic), stat=iret)
     329      ALLOCATE(dlat_lic(jml_lic), stat=iret)
     330      ALLOCATE(fraclic(iml_lic, jml_lic), stat=iret)
     331      CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp
     332     $    , lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
     333      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp
     334     $    , 1, 1, fraclic)
     335      CALL flinclo(fid)
     336C
     337C interpolation sur la grille T du modele
     338C
     339      WRITE(*,*) 'dimensions de landice iml_lic, jml_lic : ',
     340     $    iml_lic, jml_lic
     341c
     342C sil les coordonnees sont en degres, on les transforme
     343C
     344      IF( MAXVAL( lon_lic(:,:) ) .GT. 2.0 * asin(1.0) )  THEN
     345          lon_lic(:,:) = lon_lic(:,:) * 2.0* ASIN(1.0) / 180.
     346      ENDIF
     347      IF( maxval( lat_lic(:,:) ) .GT. 2.0 * asin(1.0)) THEN
     348          lat_lic(:,:) = lat_lic(:,:) * 2.0 * asin(1.0) / 180.
     349      ENDIF
     350
     351      dlon_lic(1 : iml_lic) = lon_lic(1 : iml_lic, 1)
     352      dlat_lic(1 : jml_lic) = lat_lic(1 , 1 : jml_lic)
     353C
     354      CALL grille_m(iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic
     355     $    ,iim, jjp1,
     356     $    rlonv, rlatu, flic_tmp(1 : iim, 1 : jjp1))
     357c$$$      flic_tmp(1 : iim, 1 : jjp1) = champint(1: iim, 1 : jjp1)
     358      flic_tmp(iip1, 1 : jjp1) = flic_tmp(1 , 1 : jjp1)
     359C
     360C passage sur la grille physique
     361C
     362      CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp,
     363     $    pctsrf(1:klon, is_lic))
     364C adequation avec le maque terre/mer
     365      WHERE (pctsrf(1 : klon, is_lic) .LE. EPSFRA )
     366          pctsrf(1 : klon, is_lic) = 0.
     367      END WHERE
     368      WHERE (zmasq( 1 : klon) .LE. EPSFRA)
     369          pctsrf(1 : klon, is_lic) = 0.
     370      END WHERE
     371      pctsrf(1 : klon, is_ter) = zmasq(1 : klon)
     372      DO ji = 1, klon
     373        IF (zmasq(ji) .GT. EPSFRA) THEN
     374            IF ( pctsrf(ji, is_lic) .GE. zmasq(ji)) THEN
     375                pctsrf(ji, is_lic) = zmasq(ji)
     376                pctsrf(ji, is_ter) = 0.
     377            ELSE
     378                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
     379            ENDIF
     380        ENDIF
     381      END DO
     382C
     383C sous surface ocean et glace de mer (pour demarrer on met glace de mer a 0)
     384C
     385      pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon))
     386      WHERE (pctsrf(1 : klon, is_oce) .LT. EPSFRA)
     387          pctsrf(1 : klon, is_oce) = 0.
     388      END WHERE
     389C
     390C verif que somme des sous surface = 1
     391C
     392      ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf), dim = 2)) - 1.0 )
     393     $    .GT. EPSFRA)
     394      IF (ji .NE. 0) THEN
     395          WRITE(*,*) 'pb repartition sous maille pour ',ji,' points'
     396      ENDIF
     397
     398
     399
     400
     401
    280402C Calcul intermediaire
    281403c
    … …  
    333455      solaire   = 1370.0
    334456
    335       call physdem(lonfi, latfi, phystep,radpas,co2_ppm,
    336      .                   solaire,tsol, qsol,
    337      .                   sn, radsol, deltat, rugmer,
    338      .                   agesno, zmea, zstd, zsig,
    339      .                   zgam, zthe, zpic, zval,
    340      .                   rugsrel)
     457c      call physdem(lonfi, latfi, phystep,radpas,co2_ppm,
     458c     .                   solaire,tsol, qsol,
     459c     .                   sn, radsol, deltat, rugmer,
     460c     .                   agesno, zmea, zstd, zsig,
     461c     .                   zgam, zthe, zpic, zval,
     462c     .                   rugsrel)
     463
     464c
     465c Initialisation
     466c tsol, qsol, sn,albe, evap,tsoil,rain_fall, snow_fall,solsw, sollw,frugs
     467c
     468      tsolsrf(:,is_ter) = tsol
     469      tsolsrf(:,is_lic) = tsol
     470      tsolsrf(:,is_oce) = tsol
     471      tsolsrf(:,is_sic) = tsol
     472      snsrf(:,is_ter) = sn
     473      snsrf(:,is_lic) = sn
     474      snsrf(:,is_oce) = sn
     475      snsrf(:,is_sic) = sn
     476      albe(:,is_ter) = 0.08
     477      albe(:,is_lic) = 0.6
     478      albe(:,is_oce) = 0.5
     479      albe(:,is_sic) = 0.6
     480      evap(:,:) = 0.
     481      qsolsrf(:,is_ter) = qsol
     482      qsolsrf(:,is_lic) = qsol
     483      qsolsrf(:,is_oce) = 150.
     484      qsolsrf(:,is_sic) = 150.
     485      do i = 1, nbsrf
     486        do j = 1, nsoilmx
     487          tsoil(:,j,i) = tsol
     488        enddo
     489      enddo
     490      rain_fall = 0.; snow_fall = 0.
     491      solsw = 165.
     492      sollw = -53.
     493      t_ancien = 273.15
     494      q_ancien = 0.
     495      agesno = 0.
     496      deltat = 0.
     497      frugs(:,is_oce) = rugmer
     498      frugs(:,is_ter) = rugmer
     499      frugs(:,is_lic) = rugmer
     500      frugs(:,is_sic) = rugmer
     501
     502      call phyredem("startphy.nc",phystep,radpas, co2_ppm, solaire,
     503     $    latfi, lonfi, pctsrf, tsolsrf, tsoil, deltat, qsolsrf, snsrf,
     504     $    albe, evap, rain_fall, snow_fall, solsw, sollw,
     505     $    radsol, frugs,  agesno,
     506     $    zmea, zstd, zsig, zgam, zthe, zpic, zval, rugsrel,
     507     $    t_ancien, q_ancien)
    341508
    342509C     Sortie Visu pour les champs dynamiques

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

    r99 r112  
    437437
    438438c rajout debug
    439 c        lafin = .true.
     439        lafin = .true.
    440440
    441441        CALL calfis( nqmx, lafin ,rdayvrai,rday_ecri,time  ,
    … …  
    503503
    504504c ajout debug
    505 c               IF( lafin ) then 
    506 c                 abort_message = 'Simulation finished'
    507 c                 call abort_gcm(modname,abort_message,0)
    508 c               ENDIF
     505               IF( lafin ) then 
     506                 abort_message = 'Simulation finished'
     507                 call abort_gcm(modname,abort_message,0)
     508               ENDIF
    509509       
    510510c   ********************************************************************

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

    r97 r112  
    245245C Ecriture etat initial physique
    246246C
    247       WRITE(*,*) 'zmasq avant phyredem'
     247      WRITE(*,*)'zmasq avant phyredem'
    248248      WRITE(*,*) zmasq
    249249

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/YOMCST.inc

    r97 r112  
    11! A1.0 Fundamental constants
    2       REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO
     2      REAL :: RPI,RCLUM,RHPLA,RKBOL,RNAVO
    33! A1.1 Astronomical constants
    4       REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
     4      REAL :: RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA
    55! A1.1.bis Constantes concernant l'orbite de la Terre:
    6       REAL R_ecc, R_peri, R_incl
     6      REAL :: R_ecc, R_peri, R_incl
    77! A1.2 Geoide
    8       REAL RA,RG,R1SA
     8      REAL :: RA,RG,R1SA
    99! A1.3 Radiation
    10       REAL RSIGMA,RI0
     10      REAL :: RSIGMA,RI0
    1111! A1.4 Thermodynamic gas phase
    12       REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
    13       REAL RKAPPA,RETV
     12      REAL :: R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV
     13      REAL :: RKAPPA,RETV
    1414! A1.5,6 Thermodynamic liquid,solid phases
    15       REAL RCW,RCS
     15      REAL :: RCW,RCS
    1616! A1.7 Thermodynamic transition of phase
    17       REAL RLVTT,RLSTT,RLMLT,RTT,RATM
     17      REAL :: RLVTT,RLSTT,RLMLT,RTT,RATM
    1818! A1.8 Curve of saturation
    19       REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
    20       REAL RALPD,RBETD,RGAMD
     19      REAL :: RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
     20      REAL :: RALPD,RBETD,RGAMD
    2121!
    2222      COMMON/YOMCST/RPI   ,RCLUM ,RHPLA ,RKBOL ,RNAVO &

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

    r109 r112  
    1       SUBROUTINE clmain(dtime,pctsrf,t,q,u,v,
     1      SUBROUTINE clmain(dtime,itap,pctsrf,
     2     .                  t,q,u,v,
    23     .                  jour, rmu0,
    3      .                  ok_veget,ts,
     4     .                  ok_veget, ocean, npas, nexca, ts,
    45     .                  paprs,pplay,radsol,snow,qsol,evap,albe,
    56     .                  rain_f, snow_f, solsw, sollw, fder,
    67     .                  rlon, rlat, rugos,
    7      .                  debut, lafin,
     8     .                  debut, lafin, agesno,
    89     .                  d_t,d_q,d_u,d_v,d_ts,
    910     .                  flux_t,flux_q,flux_u,flux_v,cdragh,cdragm,
    … …  
    3334c Arguments:
    3435c dtime----input-R- interval du temps (secondes)
     36c itap-----input-I- numero du pas de temps
    3537c t--------input-R- temperature (K)
    3638c q--------input-R- vapeur d'eau (kg/kg)
    … …  
    7577c
    7678      REAL dtime
     79      integer itap
    7780      REAL t(klon,klev), q(klon,klev)
    7881      REAL u(klon,klev), v(klon,klev)
    … …  
    8487      REAL dflux_t(klon), dflux_q(klon)
    8588      REAL flux_u(klon,klev, nbsrf), flux_v(klon,klev, nbsrf)
    86       REAL rugmer(klon)
     89      REAL rugmer(klon), agesno(klon)
    8790      REAL cdragh(klon), cdragm(klon)
    8891      integer jour            ! jour de l'annee en cours
    8992      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
    9093      LOGICAL debut, lafin, ok_veget
     94      character*6 ocean
     95      integer npas, nexca
    9196cAA      INTEGER itr
    9297cAA      REAL tr(klon,klev,nbtr)
    … …  
    288293        yv1(j) = v1lay(i)
    289294        yrads(j) = totalflu(i)
    290 c        ycal(j) = cal(i)
    291 c        ybeta(j) = beta(i)
    292 c        ydif(j) = dif_grnd(i)
    293295        ypaprs(j,klev+1) = paprs(i,klev+1)
    294296      ENDDO
    … …  
    331333      ytauy = y_flux_v(:,1)
    332334c calculer la diffusion de "q" et de "h"
    333       CALL clqh(knon, dtime, nsrf, ni, pctsrf, rlon, rlat,
    334      e          jour, rmu0,
     335      CALL clqh(dtime, itap, jour, debut,lafin,
     336     e          rlon, rlat,
     337     e          knon, nsrf, ni, pctsrf,
     338     e          ok_veget, ocean, npas, nexca,
     339     e          rmu0,
    335340     e          yu1, yv1, ycoefh,
    336341     e          yt,yq,yts,ypaprs,ypplay,
    … …  
    338343     e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
    339344     e          ysollw, ysolsw,
    340      s          pctsrf_new,
     345     s          pctsrf_new, agesno,
    341346     s          y_d_t, y_d_q, y_d_ts, yz0_new,
    342347     s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q)
    … …  
    349354      ENDDO
    350355      ENDIF
    351 c
    352 cAA MAINTENANT DANS PHYTRAC
    353 cAAc calculer la diffusion des traceurs
    354 cAA      IF (itr.GE.1) THEN
    355 cAA      DO it = 1, itr
    356 cAA      CALL cltrac(knon,dtime,ycoefh, yt, ytr(1,1,it), yflxsrf(1,it),
    357 cAA     e            ypaprs, ypplay, ydelp,
    358 cAA     s            y_d_tr(1,1,it))
    359 cAA      ENDDO
    360 cAA      ENDIF
    361 c
    362356      DO j = 1, knon
    363357         y_dflux_t(j) = y_dflux_t(j) * ypct(j)
    … …  
    427421      ENDDO
    428422c
    429 cAA      IF (itr.GE.1) THEN
    430 cAA      DO it = 1, itr
    431 cAA      DO k = 1, klev
    432 cAA      DO j = 1, knon
    433 cAA         y_d_tr(j,k,it) = y_d_tr(j,k,it) * ypct(j)
    434 cAA      ENDDO
    435 cAA      ENDDO
    436 cAA      ENDDO
    437 cAA      DO j = 1, knon
    438 cAA      i = ni(j)
    439 cAA      DO it = 1, itr
    440 cAA      DO k = 1, klev
    441 cAA         d_tr(i,k,it) = d_tr(i,k,it) + y_d_tr(j,k,it)
    442 cAA      ENDDO
    443 cAA      ENDDO
    444 cAA      ENDDO
    445 cAA      ENDIF
    446 c
    44742399999 CONTINUE
    448424c
     425C
     426C On utilise les nouvelles surfaces
     427C A rajouter: conservation de l'albedo
     428C
     429      pctsrf = pctsrf_new
    449430
    450431      RETURN
    451432      END
    452       SUBROUTINE clqh(knon,dtime,nisurf,knindex,pctsrf, rlon, rlat,
    453      e                jour, rmu0
     433      SUBROUTINE clqh(dtime,itime, jour,debut,lafin,
     434     e                rlon, rlat,
     435     e                knon, nisurf, knindex, pctsrf,
     436     e                ok_veget, ocean, npas, nexca,
     437     e                rmu0,
    454438     e                u1lay,v1lay,coef,
    455439     e                t,q,ts,paprs,pplay,
    … …  
    457441     e                precip_rain, precip_snow, fder, taux, tauy,
    458442     e                lwdown, swdown,
    459      s                pctsrf_new,
     443     s                pctsrf_new, agesno,
    460444     s                d_t, d_q, d_ts, z0_new,
    461445     s                flux_t, flux_q,dflux_s,dflux_l)
    … …  
    499483      REAL qsol(klon)         ! humidite de la surface
    500484      real precip_rain(klon), precip_snow(klon)
     485      REAL agesno(klon)
    501486      integer jour            ! jour de l'annee en cours
    502487      real rmu0(klon)         ! cosinus de l'angle solaire zenithal
    … …  
    504489      real pctsrf(klon,nbsrf)
    505490      real rlon(klon), rlat(klon)
     491      logical ok_veget
     492      character*6 ocean
     493      integer npas, nexca
     494
    506495c
    507496      REAL d_t(klon,klev)     ! incrementation de "t"
    … …  
    565554      integer itime
    566555      integer nisurf
    567       logical debut, lafin, ok_veget
     556      logical debut, lafin
    568557      real zlev1(klon)
    569558      real fder(klon), taux(klon), tauy(klon)
    … …  
    575564      real p1lay(klon)
    576565      real coef1lay(klon)
    577       character*6 ocean
    578566
    579567! Parametres de sortie
    … …  
    691679C Appel a interfsurf (appel generique) routine d'interface avec la surface
    692680
    693       ok_veget = .false.
    694       ocean = 'force '
    695 
    696681      petAcoef=zx_ch(:,1)
    697682      peqAcoef=zx_cq(:,1)
    … …  
    717702     e albedo, snow, qsol,
    718703     e ts, p1lay, psref, radsol,
    719      e ocean,zmasq,
     704     e ocean, npas, nexca, zmasq,
    720705     s evap, fluxsens, fluxlat, dflux_l, dflux_s,             
    721      s tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
     706     s tsol_rad, tsurf_new, alb_new, emis_new, z0_new,
     707     s pctsrf_NEW, agesno)
    722708
    723709      flux_t(:,1) = fluxsens

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

    r109 r112  
    3636
    3737#include "YOMCST.inc"
    38 
    39 
    40   ! run_off      ruissellement total
     38#include "indicesol.inc"
     39
     40
     41! run_off      ruissellement total
    4142  real, allocatable, dimension(:),save    :: run_off
    4243
    … …  
    5657      & albedo, snow, qsol, &
    5758      & tsurf, p1lay, ps, radsol, &
    58       & ocean, zmasq, &
     59      & ocean, npas, nexca, zmasq, &
    5960      & evap, fluxsens, fluxlat, dflux_l, dflux_s, &             
    60       & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
     61      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new, agesno)
    6162
    6263
    … …  
    125126!   pctsrf_new   nouvelle repartition des surfaces
    126127
    127   include 'indicesol.h'
    128128
    129129! Parametres d'entree
    … …  
    153153  real, dimension(klon), intent(IN) :: fder, taux, tauy
    154154  character (len = 6)  :: ocean
     155  integer              :: npas, nexca ! nombre et pas de temps couplage
    155156  real, dimension(knon), intent(INOUT) :: evap, snow, qsol
    156157
    … …  
    161162  real, dimension(knon), intent(OUT):: dflux_l, dflux_s
    162163  real, dimension(klon,nbsrf), intent(OUT) :: pctsrf_new
     164  real, dimension(klon), intent(INOUT):: agesno
    163165
    164166! Local
    … …  
    166168  character (len = 80) :: abort_message
    167169  logical, save        :: first_call = .true.
    168   integer              :: error
     170  INTEGER              :: error, ii
    169171  logical              :: check = .true.
    170172  real, dimension(knon):: cal, beta, dif_grnd, capsol
    171173  real, parameter      :: calice=1.0/(5.1444e+06*0.15), tau_gl=1./86400.*5.
    172174  real, parameter      :: calsno=1./(2.3867e+06*.15)
    173   integer              :: nexca !pas de temps couplage
    174175  real, dimension(knon):: alb_ice
    175176  real, dimension(knon):: tsurf_temp
    176   real, dimension(klon):: agesno, alb_neig_grid, alb_eau
     177  real, dimension(klon):: alb_neig_grid, alb_eau
    177178  real, dimension(knon):: alb_neig
     179  REAL, DIMENSION(knon):: lmt_rug, lmt_alb
     180  real, DIMENSION(knon):: zfra
    178181
    179182  if (check) write(*,*) 'Entree ', modname
    … …  
    203206      abort_message='voir ci-dessus'
    204207      call abort_gcm(modname,abort_message,1)
     208    endif
    205209  endif
    206210  first_call = .false.
    … …  
    233237!
    234238
    235   CALL albsno(agesno,alb_neig_grid) 
    236 !
    237 !
    238 !
     239  CALL albsno(klon,agesno,alb_neig_grid) 
     240 
     241 
     242 
    239243    if (.not. ok_veget) then
    240244!
    … …  
    256260     & klon, nisurf, knon, knindex, debut,  &
    257261     & lmt_alb, lmt_rug)
    258        alb_neig = alb_neig_grid(knindex)
     262!
     263! Pb compilo sun
     264!       alb_neig = alb_neig_grid(knindex)
     265!      alb_new = alb_neig*zfra + lmt_alb(knindex)*(1.0-zfra)
     266!      z0_new = lmt_rug(knindex)
     267!
     268       DO ii = 1, knon
     269         alb_neig(ii) = alb_neig_grid(knindex(ii))
     270         alb_new(ii) = lmt_alb(knindex(ii))
     271       enddo
    259272       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    260        alb_new = alb_neig*zfra + lmt_alb(knindex)*(1.0-zfra)
    261        z0_new = lmt_rug(knindex)
    262    
     273       alb_new = alb_neig*zfra + alb_new*(1.0-zfra)
     274       DO ii = 1, knon
     275         z0_new(ii) = lmt_rug(knindex(ii))
     276       enddo   
    263277    else
    264278!
    … …  
    293307      call interfoce(itime, dtime, &
    294308      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
    295       & ocean, nexca, debut, lafin, &
     309      & ocean, npas, nexca, debut, lafin, &
    296310      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    297311      & fder, albedo, taux, tauy, zmasq, &
    298312      & tsurf_new, alb_new, alb_ice, pctsrf_new)
    299 
    300       tsurf_temp = tsurf_new
    301313
    302314!    else if (ocean == 'slab  ') then
    … …  
    310322    endif
    311323
     324    tsurf_temp = tsurf_new
    312325    cal = 0.
    313326    beta = 1.
    … …  
    324337!
    325338
    326      if ( minval(rmu0) == maxval(rmu0) && minval(rmu0) = -999.999 ) then
    327        CALL alboc(FLOAT(jour),rlat,alb_eau)
    328      else  ! cycle diurne
    329        CALL alboc_cd(rmu0,alb_eau)
    330      endif
    331      alb_new = alb_eau(knindex)
    332 
     339    if ( minval(rmu0) == maxval(rmu0) .and. minval(rmu0) == -999.999 ) then
     340      CALL alboc(FLOAT(jour),rlat,alb_eau)
     341    else  ! cycle diurne
     342      CALL alboc_cd(rmu0,alb_eau)
     343    endif
     344    DO ii =1, knon
     345      alb_new(ii) = alb_eau(knindex(ii))
     346    enddo
    333347!
    334348  else if (nisurf == is_sic) then
    … …  
    341355!
    342356    if (ocean == 'couple') then
    343       nexca = 0
    344357
    345358      call interfoce(itime, dtime, &
    346359      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
    347       & ocean, nexca, debut, lafin, &
     360      & ocean, npas, nexca, debut, lafin, &
    348361      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    349362      & fder, albedo, taux, tauy, zmasq, &
    … …  
    357370!      call interfoce(nisurf)
    358371    else                              ! lecture conditions limites
    359 !      call interfoce(itime, dtime, jour, &
    360 !     &  klon, nisurf, knon, knindex, &
    361 !     &  debut, &
    362 !     &  tsurf_new, pctsrf_new)
    363 !   endif
     372      call interfoce(itime, dtime, jour, &
     373     &  klon, nisurf, knon, knindex, &
     374     &  debut, &
     375     &  tsurf_new, pctsrf_new)
    364376
    365377      cal = calice
    … …  
    381393!
    382394       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    383        alb_neig = alb_neig_grid(knindex)
     395       DO ii = 1, knon
     396         alb_neig = alb_neig_grid(knindex(ii))
     397       enddo
    384398       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
    385399
    … …  
    409423!
    410424       zfra = MAX(0.0,MIN(1.0,snow/(snow+10.0)))
    411        alb_neig = alb_neig_grid(knindex)
     425       DO ii =1, knon
     426         alb_neig = alb_neig_grid(knindex(ii))
     427       enddo
    412428       alb_new = alb_neig*zfra + 0.6 * (1.0-zfra)
    413429
    … …  
    634650  SUBROUTINE interfoce_cpl(itime, dtime, &
    635651      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
    636       & ocean, nexca, debut, lafin, &
     652      & ocean, npas, nexca, debut, lafin, &
    637653      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    638654      & fder, albsol, taux, tauy, zmasq, &
    … …  
    691707!
    692708
    693 #include 'indicesol.h'
    694709
    695710! Parametres d'entree
    … …  
    708723  real, dimension(knon), intent(IN) :: precip_rain, precip_snow
    709724  real, dimension(knon), intent(IN) :: tsurf, fder, albsol, taux, tauy
    710   integer              :: nexca
     725  INTEGER              :: nexca, npas
    711726  real, dimension(klon), intent(IN) :: zmasq
    712727
    … …  
    719734! Variables locales
    720735  integer                    :: j, error, sum_error, ig
    721   integer                    :: npas
    722736  character (len = 20) :: modname = 'interfoce_cpl'
    723737  character (len = 80) :: abort_message
    … …  
    792806! initialisation couplage
    793807!
    794     call inicma(npas, nexca, dtime)
     808    call inicma(npas , nexca, dtime)
    795809!
    796810! 1ere lecture champs ocean
    … …  
    824838  endif ! fin if (debut)
    825839
    826 !! fichier restart et fichiers histoires
    827 
    828 !! calcul des fluxs a passer
     840! fichier restart et fichiers histoires
     841
     842! calcul des fluxs a passer
    829843
    830844  cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown      / FLOAT(nexca)
    … …  
    10371051!
    10381052
    1039 #include "indicesol.h"
    10401053
    10411054! Parametres d'entree
    … …  
    10551068! Variables locales
    10561069  integer     :: ii
    1057   integer    :: lmt_pas     ! frequence de lecture des conditions limites
     1070  INTEGER,save :: lmt_pas     ! frequence de lecture des conditions limites
    10581071                             ! (en pas de physique)
    10591072  logical,save :: deja_lu    ! pour indiquer que le jour a lire a deja
    … …  
    10631076  character (len = 20) :: modname = 'interfoce_lim'
    10641077  character (len = 80) :: abort_message
    1065   character (len = 20) :: fich ='limit'
    1066   logical     :: newlmt = .false.
     1078  character (len = 20) :: fich ='limit.nc'
     1079  LOGICAL     :: newlmt = .TRUE.
    10671080  logical     :: check = .true.
    10681081! Champs lus dans le fichier de CL
    … …  
    10791092!
    10801093   
    1081   if (debut) then
     1094  if (debut .and. .not. allocated(sst_lu)) then
    10821095    lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
    10831096    jour_lu = jour - 1
    … …  
    10961109! Ouverture du fichier
    10971110!
     1111    fich = trim(fich)
    10981112    ierr = NF_OPEN (fich, NF_NOWRITE,nid)
    10991113    if (ierr.NE.NF_NOERR) then
    … …  
    11191133      endif
    11201134#ifdef NC_DOUBLE
    1121       ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_oce))
     1135      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_oce))
    11221136#else
    1123       ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_oce))
     1137      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_oce))
    11241138#endif
    11251139      if (ierr /= NF_NOERR) then
    … …  
    11361150      endif
    11371151#ifdef NC_DOUBLE
    1138       ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_sic))
     1152      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_sic))
    11391153#else
    1140       ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_sic))
     1154      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_sic))
    11411155#endif
    11421156      if (ierr /= NF_NOERR) then
    … …  
    11531167      endif
    11541168#ifdef NC_DOUBLE
    1155       ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_ter))
     1169      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_ter))
    11561170#else
    1157       ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_ter))
     1171      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_ter))
    11581172#endif
    11591173      if (ierr /= NF_NOERR) then
    … …  
    11701184      endif
    11711185#ifdef NC_DOUBLE
    1172       ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_lic))
     1186      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_lic))
    11731187#else
    1174       ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_lic))
     1188      ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_lic))
    11751189#endif
    11761190      if (ierr /= NF_NOERR) then
    … …  
    12401254! Recopie des variables dans les champs de sortie
    12411255!
    1242   lmt_sst = sst_lu(knindex)
     1256  do ii = 1, knon
     1257    lmt_sst(ii) = sst_lu(knindex(ii))
     1258  enddo
     1259! je peux pas utiliser la ligne suivante a cause du compilo Sun
     1260!  lmt_sst = sst_lu(knindex)
    12431261  pctsrf_new = pct_tmp
    12441262
    … …  
    12751293!
    12761294
    1277 #include "indicesol.h"
    12781295
    12791296! Parametres d'entree
    … …  
    13011318  character (len = 20) :: modname = 'interfoce_lim'
    13021319  character (len = 80) :: abort_message
    1303   character (len = 20) :: fich ='limit'
     1320  character (len = 20) :: fich ='limit.nc'
    13041321  logical     :: newlmt = .false.
    13051322  logical     :: check = .true.
    … …  
    13231340  endif
    13241341
    1325   if ((jour - jour_lu_sur) /= 0) deja_lu = .false.
     1342  if ((jour - jour_lu_sur) /= 0) deja_lu_sur = .false.
    13261343 
    1327   if (check) write(*,*)modname,':: jour_lu, deja_lu_sur', jour_lu, deja_lu_sur
     1344  if (check) write(*,*)modname,':: jour_lu_sur, deja_lu_sur', jour_lu_sur, deja_lu_sur
    13281345
    13291346! Tester d'abord si c'est le moment de lire le fichier
    … …  
    13321349! Ouverture du fichier
    13331350!
     1351    fich = trim(fich)
    13341352    ierr = NF_OPEN (fich, NF_NOWRITE,nid)
    13351353    if (ierr.NE.NF_NOERR) then
    … …  
    13391357!
    13401358! La tranche de donnees a lire:
    1341 !
     1359 
    13421360    start(1) = 1
    13431361    start(2) = jour + 1
    … …  
    13891407! Recopie des variables dans les champs de sortie
    13901408!
    1391   lmt_alb = alb_lu(knindex)
    1392   lmt_rug = rug_lu(knindex)
     1409  DO ii = 1, knon
     1410    lmt_alb(ii) = alb_lu(knindex(ii))
     1411    lmt_rug(ii) = rug_lu(knindex(ii))
     1412  enddo
    13931413
    13941414  END SUBROUTINE interfsur_lim
    … …  
    14411461#include "YOETHF.inc"
    14421462#include "FCTTRE.inc"
    1443 #include 'indicesol.h'
    14441463
    14451464! Parametres d'entree
    … …  
    16061625!#########################################################################
    16071626!
    1608 
    1609   SUBROUTINE sol_dem_write(itime, klon, rlon, rlat, &
    1610   &                     pctsrf_new,tsurf_new,alb_new)
    1611 
    1612 ! Routine d'ecriture de l'etat de redemarrage pour le sol
    1613 !
    1614 ! L.Fairhead
    1615 !
    1616 ! input:
    1617 !   itime        numero du pas de temps
    1618 !   klon         nombre total de points de grille
    1619 !   rlon         longitudes
    1620 !   rlat         latitudes
    1621 !   tsurf_new    temperature au sol
    1622 !   alb_new      albedo
    1623 !   pctsrf_new   repartition des surfaces
    1624 
    1625   include 'indicesol.h'
    1626 #include 'temps.inc'
    1627   include 'netcdf.inc'
    1628 
    1629 ! Parametres d'entree
    1630   integer, intent(IN) :: itime
    1631   integer, intent(IN) :: klon
    1632   real, dimension(klon), intent(IN) :: rlon, rlat
    1633   real, dimension(klon,nbsrf), intent(IN)  :: tsurf_new, alb_new
    1634   real, dimension(klon,nbsrf), intent(IN) :: pctsrf_new
    1635 
    1636 ! Variables locales
    1637   integer             :: ierr, nid
    1638   integer             :: idim1, idim2, idim3
    1639   integer,parameter   :: length = 100
    1640   character (len = 20) :: modname = 'sol_dem_write'
    1641   character (len = 80) :: abort_message
    1642   real, dimension(length) :: tab_cntrl = 0.
    1643   integer                 :: nvarid
    1644 
    1645   ierr = NF_CREATE('restartsol', NF_CLOBBER, nid)
    1646   IF (ierr.NE.NF_NOERR) THEN
    1647     abort_message=' Pb d''ouverture du fichier restartsol'
    1648     CALL abort_gcm(modname,abort_message,ierr)
    1649   ENDIF
    1650 
    1651   ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 23,    &
    1652      &                    "Fichier redemmarage sol")
    1653   ierr = NF_DEF_DIM (nid, "index", length, idim1)
    1654   ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
    1655   ierr = NF_DEF_DIM (nid, "nombre_surfaces", nbsrf, idim3)
    1656   ierr = NF_ENDDEF(nid)
    1657 
    1658   tab_cntrl(13) = day_end
    1659   tab_cntrl(14) = anne_ini
    1660 
    1661   ierr = NF_REDEF (nid)
    1662 #ifdef NC_DOUBLE
    1663   ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
    1664 #else
    1665   ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
    1666 #endif
    1667   ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,  &
    1668      &                        "Parametres de controle")
    1669   ierr = NF_ENDDEF(nid)
    1670 #ifdef NC_DOUBLE
    1671   ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
    1672 #else
    1673   ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
    1674 #endif
    1675 
    1676   ierr = NF_REDEF (nid)
    1677 #ifdef NC_DOUBLE
    1678   ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
    1679 #else
    1680   ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
    1681 #endif
    1682   ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,  &
    1683      &               "Longitudes de la grille physique")
    1684   ierr = NF_ENDDEF(nid)
    1685 #ifdef NC_DOUBLE
    1686   ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
    1687 #else
    1688   ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
    1689 #endif
    1690 !
    1691   ierr = NF_REDEF (nid)
    1692 #ifdef NC_DOUBLE
    1693   ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
    1694 #else
    1695   ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
    1696 #endif
    1697   ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,    &
    1698      &                        "Latitudes de la grille physique")
    1699   ierr = NF_ENDDEF(nid)
    1700 #ifdef NC_DOUBLE
    1701   ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
    1702 #else
    1703   ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
    1704 #endif
    1705         ierr = NF_REDEF (nid)
    1706 #ifdef NC_DOUBLE
    1707         ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
    1708 #else
    1709         ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
    1710 #endif
    1711         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22, &
    1712      &                        "Temperature de surface")
    1713         ierr = NF_ENDDEF(nid)
    1714 
    1715 
    1716 
    1717 
    1718   END SUBROUTINE sol_dem_write
    1719 !
    1720 !#########################################################################
    1721 !
    17221627  SUBROUTINE gath2cpl(champ_in, champ_out, klon, knon, iim, jjm, knindex)
    17231628
    … …  
    18061711!#########################################################################
    18071712!
    1808 !
    1809 !#########################################################################
    1810 !
    1811   SUBROUTINE albsno(agesno,alb_neig_grid)
     1713  SUBROUTINE albsno(klon, agesno,alb_neig_grid)
    18121714  IMPLICIT none
    1813 c
    1814 #include "dimensions.h"
    1815 #include "dimphy.h"
    1816   INTEGER nvm
    1817   PARAMETER (nvm=8)
    1818   REAL veget(klon,nvm)
    1819   REAL alb_neig(klon)
    1820   REAL agesno(klon)
    1821 c
    1822   INTEGER i, nv
    1823 c
    1824   REAL init(nvm), decay(nvm), as
    1825   SAVE init, decay
     1715 
     1716  integer :: klon
     1717  INTEGER, PARAMETER :: nvm = 8
     1718  REAL, dimension(klon,nvm) :: veget
     1719  REAL, DIMENSION(klon) :: alb_neig_grid, agesno
     1720 
     1721  INTEGER :: i, nv
     1722 
     1723  REAL, DIMENSION(nvm),SAVE :: init, decay
     1724  REAL :: as
    18261725  DATA init /0.55, 0.14, 0.18, 0.29, 0.15, 0.15, 0.14, 0./
    18271726  DATA decay/0.30, 0.67, 0.63, 0.45, 0.40, 0.14, 0.06, 1./
    1828 c
     1727 
    18291728  veget = 0.
    18301729  veget(:,1) = 1.     ! desert partout
    18311730  DO i = 1, klon
    1832     alb_neig(i) = 0.0
     1731    alb_neig_grid(i) = 0.0
    18331732  ENDDO
    18341733  DO nv = 1, nvm
    18351734    DO i = 1, klon
    18361735      as = init(nv)+decay(nv)*EXP(-agesno(i)/5.)
    1837       alb_neig(i) = alb_neig(i) + veget(i,nv)*as
     1736      alb_neig_grid(i) = alb_neig_grid(i) + veget(i,nv)*as
    18381737    ENDDO
    18391738  ENDDO
    1840 c
     1739 
    18411740  END SUBROUTINE albsno
    18421741!

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

    r98 r112  
    22     .            rlat,rlon, pctsrf, tsol,tsoil,deltat,qsol,snow,
    33     .           albe, evap, rain_fall, snow_fall, solsw, sollw,
    4      .           radsol,rugmer,agesno,clesphy0,
     4     .           radsol,frugs,agesno,clesphy0,
    55     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
    66     .           t_ancien,q_ancien,ancien_ok)
    … …  
    3535      REAL sollw(klon)
    3636      real solsw(klon)
    37       REAL rugmer(klon)
     37      REAL frugs(klon,nbsrf)
    3838      REAL agesno(klon)
    3939      REAL zmea(klon)
    … …  
    640640              xmax = MAX(evap(i,nsrf),xmax)
    641641           ENDDO
    642            PRINT*,'Neige du sol EVAP**:', nsrf, xmin, xmax
     642           PRINT*,'evap du sol EVAP**:', nsrf, xmin, xmax
    643643         ENDDO
    644644      ELSE
    … …  
    660660            xmax = MAX(evap(i,1),xmax)
    661661         ENDDO
    662          PRINT*,'Neige du sol <EVAP>', xmin, xmax
     662         PRINT*,'Evap du sol <EVAP>', xmin, xmax
    663663         DO nsrf = 2, nbsrf
    664664         DO i = 1, klon
    … …  
    793793      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
    794794c
    795 c Lecture de la longueur de rugosite en mer:
    796 c
    797       ierr = NF_INQ_VARID (nid, "RUGMER", nvarid)
    798       IF (ierr.NE.NF_NOERR) THEN
    799          PRINT*, 'phyetat0: Le champ <RUGMER> est absent'
    800          CALL abort
    801       ENDIF
    802 #ifdef NC_DOUBLE
    803       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugmer)
    804 #else
    805       ierr = NF_GET_VAR_REAL(nid, nvarid, rugmer)
    806 #endif
    807       IF (ierr.NE.NF_NOERR) THEN
    808          PRINT*, 'phyetat0: Lecture echouee pour <RUGMER>'
    809          CALL abort
    810       ENDIF
    811       xmin = 1.0E+20
    812       xmax = -1.0E+20
    813       DO i = 1, klon
    814          xmin = MIN(rugmer(i),xmin)
    815          xmax = MAX(rugmer(i),xmax)
    816       ENDDO
    817       PRINT*,'Rugosite sur la mer rugmer:', xmin, xmax
     795c Lecture de la longueur de rugosite
     796c
     797c
     798      ierr = NF_INQ_VARID (nid, "RUG", nvarid)
     799      IF (ierr.NE.NF_NOERR) THEN
     800         PRINT*, 'phyetat0: Le champ <RUG> est absent'
     801         PRINT*, '          Mais je vais essayer de lire RUG**'
     802         DO nsrf = 1, nbsrf
     803           IF (nsrf.GT.99) THEN
     804             PRINT*, "Trop de sous-mailles"
     805             CALL abort
     806           ENDIF
     807           WRITE(str2,'(i2.2)') nsrf
     808           ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)
     809           IF (ierr.NE.NF_NOERR) THEN
     810              PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"
     811              CALL abort
     812           ENDIF
     813#ifdef NC_DOUBLE
     814           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf))
     815#else
     816           ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))
     817#endif
     818           IF (ierr.NE.NF_NOERR) THEN
     819             PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"
     820             CALL abort
     821           ENDIF
     822           xmin = 1.0E+20
     823           xmax = -1.0E+20
     824           DO i = 1, klon
     825              xmin = MIN(frugs(i,nsrf),xmin)
     826              xmax = MAX(frugs(i,nsrf),xmax)
     827           ENDDO
     828           PRINT*,'evap du sol RUG**:', nsrf, xmin, xmax
     829         ENDDO
     830      ELSE
     831         PRINT*, 'phyetat0: Le champ <RUG> est present'
     832         PRINT*, '          J ignore donc les autres RUG**'
     833#ifdef NC_DOUBLE
     834         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1))
     835#else
     836         ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))
     837#endif
     838         IF (ierr.NE.NF_NOERR) THEN
     839            PRINT*, "phyetat0: Lecture echouee pour <RUG>"
     840            CALL abort
     841         ENDIF
     842         xmin = 1.0E+20
     843         xmax = -1.0E+20
     844         DO i = 1, klon
     845            xmin = MIN(frugs(i,1),xmin)
     846            xmax = MAX(frugs(i,1),xmax)
     847         ENDDO
     848         PRINT*,'Neige du sol <RUG>', xmin, xmax
     849         DO nsrf = 2, nbsrf
     850         DO i = 1, klon
     851            frugs(i,nsrf) = frugs(i,1)
     852         ENDDO
     853         ENDDO
     854      ENDIF
     855
    818856c
    819857c Lecture de l'age de la neige:

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

    r98 r112  
    33     .           albedo, evap, rain_fall, snow_fall,
    44     .           solsw, sollw,
    5      .           radsol,rugmer,agesno,
     5     .           radsol,frugs,agesno,
    66     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
    77     .           t_ancien, q_ancien)
    … …  
    3838      real sollw(klon)
    3939      REAL radsol(klon)
    40       REAL rugmer(klon)
     40      REAL frugs(klon,nbsrf)
    4141      REAL agesno(klon)
    4242      REAL zmea(klon)
    … …  
    464464#endif
    465465c
    466       ierr = NF_REDEF (nid)
    467 #ifdef NC_DOUBLE
    468       ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
    469 #else
    470       ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
    471 #endif
    472       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    473      .                        "Longueur de rugosite sur mer")
    474       ierr = NF_ENDDEF(nid)
    475 #ifdef NC_DOUBLE
    476       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer)
    477 #else
    478       ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer)
    479 #endif
     466      DO nsrf = 1, nbsrf
     467        IF (nsrf.LE.99) THEN
     468        WRITE(str2,'(i2.2)') nsrf
     469        ierr = NF_REDEF (nid)
     470#ifdef NC_DOUBLE
     471        ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_DOUBLE,1,idim2,nvarid)
     472#else
     473        ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_FLOAT,1,idim2,nvarid)
     474#endif
     475        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
     476     .                        "rugosite de surface No."//str2)
     477        ierr = NF_ENDDEF(nid)
     478        ELSE
     479        PRINT*, "Trop de sous-mailles"
     480        CALL abort
     481        ENDIF
     482#ifdef NC_DOUBLE
     483      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,nsrf))
     484#else
     485      ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,nsrf))
     486#endif
     487      ENDDO
    480488c
    481489      ierr = NF_REDEF (nid)

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

    r109 r112  
    7070      logical rnpb
    7171      parameter(rnpb=.true.)
    72       PARAMETER (npas=1440)
    73       PARAMETER (nexca=48)
    74       PARAMETER (itimestep=1800)
     72c      PARAMETER (npas=1440)
     73c      PARAMETER (nexca=48)
     74c      PARAMETER (itimestep=1800)
    7575      EXTERNAL fromcpl, intocpl, inicma
    7676      REAL cpl_sst(iim,jjmp1), cpl_sic(iim,jjmp1)
    7777      REAL cpl_alb_sst(iim,jjmp1), cpl_alb_sic(iim,jjmp1)
     78      character *6 ocean
     79      parameter (ocean = 'force ')
    7880c======================================================================
    7981c ok_ocean indique l'utilisation du modele oceanique "slab ocean",
    … …  
    669671         PRINT*, 'La frequence de sortie region est de ', ecrit_reg
    670672         ENDIF
     673
     674c
     675c Initialiser le couplage si necessaire
     676c
     677      npas = 0
     678      nexca = 0
     679      if (ocean == 'couple') then
     680        npas = itaufin/ iphysiq
     681        nexca = 86400 / dtime
     682        write(*,*)' ##### Ocean couple #####'
     683        write(*,*)' Valeurs des pas de temps'
     684        write(*,*)' npas = ', npas
     685        write(*,*)' nexca = ', nexca
     686      endif       
    671687c
    672688c
    … …  
    15361552      DO i = 1, klon
    15371553        if (.not. ok_veget) then
    1538          frugs(i,is_ter) = SQRT(frugs(i,is_ter)**2+rugoro(i)**2)
     1554          frugs(i,is_ter) = SQRT(frugs(i,is_ter)**2+rugoro(i)**2)
     1555        endif
    15391556         frugs(i,is_lic) = rugoro(i)
    15401557         frugs(i,is_oce) = rugmer(i)
    … …  
    15631580      ENDIF
    15641581
    1565       CALL clmain(dtime,pctsrf,
     1582      CALL clmain(dtime,itap,pctsrf,
    15661583     e            t_seri,q_seri,u_seri,v_seri,
    15671584     e            julien, rmu0,
    1568      e            ok_veget, ftsol,
     1585     e            ok_veget, ocean, npas, nexca, ftsol,
    15691586     e            paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,
    15701587     e            rain_fall, snow_fall, solsw, sollw, fder,
    15711588     e            rlon, rlat, frugs,
    1572      e            debut, lafin,
     1589     e            debut, lafin, agesno,
    15731590     s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
    15741591     s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,rugmer,
    … …  
    27932810     .      falbe, fevap, rain_fall, snow_fall,
    27942811     .      solsw, sollw,
    2795      .      radsol,rugmer,agesno,
     2812     .      radsol,frugs,agesno,
    27962813     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
    27972814     .      t_ancien, q_ancien)
Note: See TracChangeset for help on using the changeset viewer.