Changeset 883


Ignore:
Timestamp:
Jan 31, 2008, 6:20:42 PM (17 years ago)
Author:
Laurent Fairhead
Message:

modifications pour faire de l'aquaplanète FH
LF

Location:
LMDZ4/trunk/libf/phylmd
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/conf_phys.F90

    r879 r883  
    66
    77  subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, ok_hf, &
    8  &                     seuil_inversion, &
     8 &                     solarlong0,qsol0,seuil_inversion, &
    99 &                     fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
    1010 &                     iflag_cldcon, &
    … …  
    2626include "compbl.h"
    2727include "control.h"
     28include "comsoil.h"
    2829!
    2930! Configuration de la "physique" de LMDZ a l'aide de la fonction
    … …  
    9394  INTEGER,SAVE :: iflag_pdf_omp
    9495  REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp
     96  REAL,SAVE :: inertie_sol_omp,inertie_sno_omp,inertie_ice_omp
     97  REAL      :: qsol0
     98  REAL,SAVE :: qsol0_omp
     99  REAL      :: solarlong0
     100  REAL,SAVE :: solarlong0_omp
    95101  INTEGER,SAVE :: top_height_omp,overlap_omp
    96102  REAL,SAVE :: cdmmax_omp,cdhmax_omp,ksta_omp,ksta_ter_omp
    … …  
    536542  ratqshaut_omp = 0.3
    537543  call getin('ratqshaut',ratqshaut_omp)
     544
     545!
     546!-----------------------------------------------------------------------
     547! Longitude solaire pour le calcul de l'ensoleillement en degre
     548! si on veut imposer la saison. Sinon, solarlong0=-999.999
     549!Config Key  = solarlong0
     550!Config Desc = 
     551!Config Def  = -999.999
     552!Config Help =
     553!
     554  solarlong0_omp = -999.999
     555  call getin('solarlong0',solarlong0_omp)
     556!
     557!-----------------------------------------------------------------------
     558!  Valeur imposee de l'humidite du sol pour le modele bucket.
     559!Config Key  = qsol0
     560!Config Desc = 
     561!Config Def  = -1.
     562!Config Help =
     563!
     564  qsol0_omp = -1.
     565  call getin('qsol0',qsol0_omp)
     566!
     567!-----------------------------------------------------------------------
     568!
     569!Config Key  = inertie_ice
     570!Config Desc = 
     571!Config Def  = 2000.
     572!Config Help =
     573!
     574  inertie_ice_omp = 2000.
     575  call getin('inertie_ice',inertie_ice_omp)
     576!
     577!Config Key  = inertie_sno
     578!Config Desc = 
     579!Config Def  = 2000.
     580!Config Help =
     581!
     582  inertie_sno_omp = 2000.
     583  call getin('inertie_sno',inertie_sno_omp)
     584!
     585!Config Key  = inertie_sol
     586!Config Desc = 
     587!Config Def  = 2000.
     588!Config Help =
     589!
     590  inertie_sol_omp = 2000.
     591  call getin('inertie_sol',inertie_sol_omp)
    538592
    539593!
    … …  
    872926    reevap_ice = reevap_ice_omp
    873927    iflag_pdf = iflag_pdf_omp
     928    solarlong0 = solarlong0_omp
     929    qsol0 = qsol0_omp
     930    inertie_sol = inertie_sol_omp
     931    inertie_ice = inertie_ice_omp
     932    inertie_sno = inertie_sno_omp
    874933    rad_froid = rad_froid_omp
    875934    rad_chau1 = rad_chau1_omp
    … …  
    9961055  write(numout,*)' type_run = ',type_run
    9971056  write(numout,*)' ok_isccp = ',ok_isccp
     1057  WRITE(numout,*)' solarlong0 = ', solarlong0
     1058  write(numout,*)' qsol0 = ', qsol0
     1059  write(numout,*)' inertie_sol = ', inertie_sol
     1060  write(numout,*)' inertie_ice = ', inertie_ice
     1061  write(numout,*)' inertie_sno = ', inertie_sno
     1062
    9981063  write(numout,*)' lonmin lonmax latmin latmax bilKP_ins =',&
    9991064 & lonmin_ins, lonmax_ins, latmin_ins, latmax_ins

  • LMDZ4/trunk/libf/phylmd/fisrtilp.F

    r766 r883  
    6363
    6464      INTEGER ninter ! sous-intervals pour la precipitation
     65      INTEGER ncoreczq
    6566      PARAMETER (ninter=5)
    6667      LOGICAL evap_prec ! evaporation de la pluie
    … …  
    210211cAA----------------------------------------------------------
    211212c
     213      ncoreczq=0
    212214c Boucle verticale (du haut vers le bas)
    213215c
    … …  
    342344           do i=1,klon
    343345              if(zq(i).lt.1.e-15) then
    344                 print*,'ZQ(',i,',',k,')=',zq(i)
     346                ncoreczq=ncoreczq+1
    345347                zq(i)=1.e-15
    346348              endif
    … …  
    539541      END DO
    540542c
     543
     544      if (ncoreczq>0) then
     545         print*,'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
     546      endif
    541547      RETURN
    542548      END

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r881 r883  
    687687c
    688688      REAL qsol(klon)
     689      REAL,save :: qsol0
     690      REAL,save ::  solarlong0
    689691c
    690692      REAL,allocatable,save :: falbe(:,:)
    … …  
    14781480c======================================================================
    14791481
    1480       if (klon.eq.1) then
    1481           print*,'WARNING !!!! omega=0'
    1482           omega=0.
    1483           igout=1
     1482      if (1.eq.1) then
     1483          igout=klon/2
    14841484         write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    14851485         write(lunout,*)
    … …  
    17381738c
    17391739         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
    1740      .                  ok_instan, ok_hf, seuil_inversion,
     1740     .                  ok_instan, ok_hf,
     1741     .                  solarlong0,qsol0,seuil_inversion,
    17411742     .                  fact_cldcon, facttemps,ok_newmicro,iflag_radia,
    17421743     .                  iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,
    … …  
    22562257
    22572258c
    2258 C calculs necessaires au calcul de l'albedo dans l'interface
    2259 c
    2260       CALL orbite(FLOAT(julien),zlongi,dist)
     2259c=========================================================================
     2260! Calculs de l'orbite.
     2261! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
     2262! doit donc etre placé avant radlwsw et pbl_surface
     2263
     2264!   choix entre calcul de la longitude solaire vraie ou valeur fixee a
     2265!   solarlong0
     2266
     2267      if (solarlong0<-999.) then
     2268         CALL orbite(FLOAT(julien),zlongi,dist)
     2269      else
     2270         zlongi=solarlong0  ! longitude solaire vraie
     2271         dist=1.            ! distance au soleil / moyenne
     2272      endif
     2273
     2274      print*,'Longitude solaire ',zlongi,solarlong0
     2275
     2276!  Avec ou sans cycle diurne
    22612277      IF (cycle_diurne) THEN
    22622278        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
    … …  
    22922308c   dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
    22932309c
     2310
     2311      if (qsol0>0.) qsol(:)=qsol0
     2312
    22942313      CALL pbl_surface(
    22952314     e     dtime,     date0,     itap,    julien,

  • LMDZ4/trunk/libf/phylmd/soil.F

    r776 r883  
    5656#include "dimsoil.h"
    5757#include "indicesol.h"
     58#include "comsoil.h"
    5859
    5960c-----------------------------------------------------------------------
    … …  
    9192      SAVE firstcall, firstsurf
    9293c$OMP THREADPRIVATE(firstcall, firstsurf)
    93       REAL isol,isno,iice
    94       SAVE isol,isno,iice
    95 c$OMP THREADPRIVATE(isol,isno,iice)
    9694      DATA firstcall/.true./
    9795      DATA firstsurf/.TRUE.,.TRUE.,.TRUE.,.TRUE./
    9896
    99       DATA isol,isno,iice/2000.,2000.,2000./
    10097      LOGICAL,SAVE :: First=.true.
    10198c$OMP THREADPRIVATE(First)
    … …  
    108105      pfluxgrd(:) = 0.
    109106c   calcul de l'inertie thermique a partir de la variable rnat.
    110 c   on initialise a iice meme au-dessus d'un point de mer au cas
     107c   on initialise a inertie_ice meme au-dessus d'un point de mer au cas
    111108c   ou le point de mer devienne point de glace au pas suivant
    112109c   on corrige si on a un point de terre avec ou sans glace
    … …  
    119116      IF (indice.EQ.is_sic) THEN
    120117         DO ig = 1, knon
    121             ztherm_i(ig)   = iice
    122             IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
     118            ztherm_i(ig)   = inertie_ice
     119            IF (snow(ig).GT.0.0) ztherm_i(ig)   = inertie_sno
    123120         ENDDO
    124121      ELSE IF (indice.EQ.is_lic) THEN
    125122         DO ig = 1, knon
    126             ztherm_i(ig)   = iice
    127             IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
     123            ztherm_i(ig)   = inertie_ice
     124            IF (snow(ig).GT.0.0) ztherm_i(ig)   = inertie_sno
    128125         ENDDO
    129126      ELSE IF (indice.EQ.is_ter) THEN
    130127         DO ig = 1, knon
    131             ztherm_i(ig)   = isol
    132             IF (snow(ig).GT.0.0) ztherm_i(ig)   = isno
     128            ztherm_i(ig)   = inertie_sol
     129            IF (snow(ig).GT.0.0) ztherm_i(ig)   = inertie_sno
    133130         ENDDO
    134131      ELSE IF (indice.EQ.is_oce) THEN
    135132         DO ig = 1, knon
    136             ztherm_i(ig)   = iice
     133            ztherm_i(ig)   = inertie_ice
    137134         ENDDO
    138135      ELSE

  • LMDZ4/trunk/libf/phylmd/thermcell_flux.F90

    r878 r883  
    206206
    207207
    208       if (1.eq.0) then
     208      if (1.eq.1) then
    209209!     do l=1,klev
    210210         do ig=1,ngrid

  • LMDZ4/trunk/libf/phylmd/thermcell_main.F90

    r879 r883  
    5959!   ------
    6060
    61       integer,save :: igout=1521
     61      integer,save :: igout=1
    6262      integer,save :: lunout=6
    63       integer,save :: lev_out=1
     63      integer,save :: lev_out=10
    6464
    6565      INTEGER ig,k,l,ll
    … …  
    429429     &                   po,pdoadj,zoa,lev_out)
    430430
    431       if (1.eq.0) then
    432 
    433 ! Calcul du transport de V tenant compte d'echange par gradient
    434 ! de pression horizontal avec l'environnement
    435 
    436          call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
    437      &    ,fraca,zmax  &
    438      &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
    439       else
    440 
    441 ! calcul purement conservatif pour le transport de V
    442          call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
    443      &    ,zu,pduadj,zua,lev_out)
    444          call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
    445      &    ,zv,pdvadj,zva,lev_out)
    446       endif
    447 
    448 !     print*,'13 OK convect8'
    449       do l=1,nlay
    450          do ig=1,ngrid
    451            pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) 
    452          enddo
    453       enddo
    454 
    455       print*,'14 OK convect8'
    456 !------------------------------------------------------------------
    457 !   Calculs de diagnostiques pour les sorties
    458 !------------------------------------------------------------------
    459 !calcul de fraca pour les sorties
    460      
    461       if (sorties) then
     431!------------------------------------------------------------------
     432! Calcul de la fraction de l'ascendance
     433!------------------------------------------------------------------
    462434      do ig=1,klon
    463435         fraca(ig,1)=0.
     436         fraca(ig,nlay+1)=0.
    464437      enddo
    465438      do l=2,nlay
    … …  
    473446      enddo
    474447     
     448!------------------------------------------------------------------
     449!  calcul du transport vertical du moment horizontal
     450!------------------------------------------------------------------
     451
     452      if (1.eq.1) then
     453
     454
     455! Calcul du transport de V tenant compte d'echange par gradient
     456! de pression horizontal avec l'environnement
     457
     458         call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
     459     &    ,fraca,zmax  &
     460     &    ,zu,zv,pduadj,pdvadj,zua,zva,igout,lev_out)
     461      else
     462
     463! calcul purement conservatif pour le transport de V
     464         call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
     465     &    ,zu,pduadj,zua,lev_out)
     466         call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
     467     &    ,zv,pdvadj,zva,lev_out)
     468      endif
     469
     470!     print*,'13 OK convect8'
     471      do l=1,nlay
     472         do ig=1,ngrid
     473           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) 
     474         enddo
     475      enddo
     476
     477      print*,'14 OK convect8'
     478!------------------------------------------------------------------
     479!   Calculs de diagnostiques pour les sorties
     480!------------------------------------------------------------------
     481!calcul de fraca pour les sorties
     482     
     483      if (sorties) then
    475484      print*,'14a OK convect8'
    476485! calcul du niveau de condensation
Note: See TracChangeset for help on using the changeset viewer.