Ignore:
Timestamp:
Jul 21, 2017, 4:02:38 PM (7 years ago)
Author:
mlefevre
Message:

Mesoscale modification for Venus LMD physics

Location:
trunk/LMDZ.VENUS/libf/phyvenus
Files:
2 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.VENUS/libf/phyvenus/clesphys.h

    r1718 r1723  
    1313       LOGICAL callnlte,callnirco2,callthermos
    1414       LOGICAL ok_cloud, ok_chem, reinit_trac, ok_sedim
     15       LOGICAL cclmain
    1516       LOGICAL startphy_file
    1617       INTEGER nbapp_rad, nbapp_chim, iflag_con, iflag_ajs
    … …  
    3132
    3233       COMMON/clesphys_i/ nbapp_rad, nbapp_chim,                        &
    33      &     iflag_con, iflag_ajs,                                        &
     34     &     iflag_con, iflag_ajs,cclmain,                                &
    3435     &     lev_histins, lev_histday, lev_histmth, tr_scheme,            &
    3536     &     cl_scheme, nircorr, nltemodel, solvarmod, nb_mode

  • trunk/LMDZ.VENUS/libf/phyvenus/clmain.F

    r1658 r1723  
    3737      use mod_grid_phy_lmdz, only: nbp_lev
    3838      use cpdet_phy_mod, only: t2tpot
     39      use turb_mod, only :yustar
    3940      IMPLICIT none
    4041c======================================================================
    … …  
    132133      real ykmm(klon,klev+1),ykmn(klon,klev+1)
    133134      real ykmq(klon,klev+1)
    134       real yustar(klon),y_cd_m(klon),y_cd_h(klon)
     135      real y_cd_m(klon),y_cd_h(klon)
    135136c
    136137#include "YOMCST.h"

  • trunk/LMDZ.VENUS/libf/phyvenus/conf_phys.F90

    r1718 r1723  
    77  subroutine conf_phys(ok_journe, ok_mensuel, ok_instan, &
    88 &                     if_ebil)
    9 
    10    use init_print_control_mod, only: init_print_control
    11    use print_control_mod, only: lunout
     9   !use init_print_control_mod, only: init_print_control
     10   !use print_control_mod, only: lunout
    1211   use IOIPSL
     12
    1313   implicit none
    1414
    … …  
    2727
    2828! Local
    29 !  integer              :: numout = 6
    30 
    31 
    32   ! Initialize flags lunout, prt_level, debug (in print_control_mod)
    33   CALL init_print_control
     29  integer              :: numout = 6
     30
    3431
    3532!
    … …  
    5249!Config  Help = Cette option permet d'eteidre le cycle diurne.
    5350!Config         Peut etre util pour accelerer le code !
    54        cycle_diurne = .TRUE.
    55        CALL getin('cycle_diurne',cycle_diurne)
     51       !cycle_diurne = .FALSE.
     52       cycle_diurne = .TRUE.       
     53       call getin('cycle_diurne',cycle_diurne)
    5654
    5755!Config  Key  = soil_model
    … …  
    6159!Config         Option qui pourait un string afin de pouvoir
    6260!Config         plus de choix ! Ou meme une liste d'options !
    63        soil_model = .TRUE.
    64        CALL getin('soil_model',soil_model)
     61       soil_model = .true.
     62       call getin('soil_model',soil_model)
    6563
    6664!Config  Key  = ok_orodr
    … …  
    6967!Config  Help = GW drag orographie
    7068!Config         
    71        ok_orodr = .TRUE.
    72        CALL getin('ok_orodr',ok_orodr)
     69       ok_orodr = .true.
     70       call getin('ok_orodr',ok_orodr)
    7371
    7472!Config  Key  =  ok_orolf
    … …  
    7674!Config  Def  = n
    7775!Config  Help = GW lift orographie (pas utilise)
    78        ok_orolf = .TRUE.
    79        CALL getin('ok_orolf', ok_orolf)
     76       ok_orolf = .true.
     77       call getin('ok_orolf', ok_orolf)
    8078
    8179!Config  Key  = ok_gw_nonoro
    … …  
    8381!Config  Def  = n
    8482!Config  Help = GW drag non-orographique
    85        ok_gw_nonoro = .FALSE.
    86        CALL getin('ok_gw_nonoro',ok_gw_nonoro)
     83       ok_gw_nonoro = .true.
     84       call getin('ok_gw_nonoro',ok_gw_nonoro)
    8785
    8886!Config  Key  = nbapp_rad
    … …  
    9290!Config         par jour.
    9391       nbapp_rad = 12
    94        CALL getin('nbapp_rad',nbapp_rad)
    95 
     92       call getin('nbapp_rad',nbapp_rad)
     93       print*,"nbapp_rad",nbapp_rad
    9694!Config  Key  = nbapp_chim
    9795!Config  Desc = Frequence d'appel a la chimie
    … …  
    10098!Config         par jour.
    10199       nbapp_chim = 1
    102        CALL getin('nbapp_chim',nbapp_chim)
     100       call getin('nbapp_chim',nbapp_chim)
    103101
    104102!Config  Key  = iflag_con
    … …  
    111109!Config         3 pour CCM(NCAR) 
    112110       iflag_con = 0
    113        CALL getin('iflag_con',iflag_con)
     111       call getin('iflag_con',iflag_con)
    114112
    115113!******************* fin parametres anciennement lus dans gcm.def
    … …  
    126124!Config Key  = OK_mensuel
    127125!Config Desc = Pour des sorties mensuelles
    128 !Config Def  = .false.
     126!Config Def  = .true.
    129127!Config Help = Pour creer le fichier histmth contenant les sorties
    130128!              mensuelles
    131129!
    132   ok_mensuel = .false.
     130  ok_mensuel = .true.
    133131  call getin('OK_mensuel', ok_mensuel)
    134132!
    … …  
    149147!
    150148       ecriphy = 1.
    151        CALL getin('ecritphy', ecriphy)
     149       call getin('ecritphy', ecriphy)
    152150!
    153151!
    … …  
    253251  call getin('ok_kzmin',ok_kzmin)
    254252
     253  cclmain = .true.
     254  call getin('clmain',cclmain)
    255255
    256256!Config Key  = iflag_ajs
    … …  
    259259!Config Help =
    260260!
    261   iflag_ajs = 1
     261  iflag_ajs = 0
    262262  call getin('iflag_ajs',iflag_ajs)
    263263
    … …  
    342342!Config Help =
    343343!
    344   ok_cloud = .FALSE.
     344  ok_cloud = .false.
     345  !ok_cloud = .true.
    345346  call getin('ok_cloud',ok_cloud)
    346 
    347 !
    348 !Config Key  = cl_scheme
    349 !Config Desc =
    350 !Config Def  = 2
    351 !Config Help =
    352 !
    353 ! 1   = Simple microphysics (Aurelien Stolzenbach's PhD)
    354 ! 2   = Full microphysics (momentum scheme, Sabrina Guilbon's PhD)
    355 
    356   cl_scheme = 2
    357   call getin('cl_scheme',cl_scheme)
    358347
    359348!
    … …  
    363352!Config Help =
    364353!
    365   ok_chem = .FALSE.
     354  ok_chem = .false.
     355  !ok_chem = .TRUE.
    366356  call getin('ok_chem',ok_chem)
    367357
    … …  
    381371!Config Help =
    382372!
    383   ok_sedim = .FALSE.
     373  ok_sedim = .false.
     374  !ok_sedim=.TRUE.
    384375  call getin('ok_sedim',ok_sedim)
    385376
    … …  
    482473!
    483474
    484   write(lunout,*)' ##############################################'
    485   write(lunout,*)' Configuration des parametres de la physique: '
    486   write(lunout,*)' cycle_diurne = ', cycle_diurne
    487   write(lunout,*)' soil_model = ', soil_model
    488   write(lunout,*)' ok_orodr = ', ok_orodr
    489   write(lunout,*)' ok_orolf = ', ok_orolf
    490   write(lunout,*)' ok_gw_nonoro = ', ok_gw_nonoro
    491   write(lunout,*)' nbapp_rad = ', nbapp_rad
    492   write(lunout,*)' nbapp_chim = ', nbapp_chim
    493   write(lunout,*)' iflag_con = ', iflag_con
    494   write(lunout,*)' Sortie journaliere = ', ok_journe
    495   write(lunout,*)' Sortie mensuelle = ', ok_mensuel
    496   write(lunout,*)' Sortie instantanee = ', ok_instan
    497   write(lunout,*)' frequence sorties = ', ecriphy 
    498   write(lunout,*)' Sortie bilan d''energie, if_ebil =', if_ebil
    499   write(lunout,*)' Excentricite = ',R_ecc
    500   write(lunout,*)' Equinoxe = ',R_peri
    501   write(lunout,*)' Inclinaison =',R_incl
    502   write(lunout,*)' tr_scheme = ', tr_scheme
    503   write(lunout,*)' iflag_pbl = ', iflag_pbl
    504   write(lunout,*)' z0 = ',z0
    505   write(lunout,*)' lmixmin = ',lmixmin
    506   write(lunout,*)' ksta = ',ksta
    507   write(lunout,*)' ok_kzmin = ',ok_kzmin
    508   write(lunout,*)' inertie = ', inertie
    509   write(lunout,*)' iflag_ajs = ', iflag_ajs
    510   write(lunout,*)' lev_histins = ',lev_histins
    511   write(lunout,*)' lev_histday = ',lev_histday
    512   write(lunout,*)' lev_histmth = ',lev_histmth
    513   write(lunout,*)' reinit_trac = ',reinit_trac
    514   write(lunout,*)' ok_cloud = ',ok_cloud
    515   write(lunout,*)' ok_chem = ',ok_chem
    516   write(lunout,*)' ok_sedim = ',ok_sedim
    517   write(lunout,*)' nb_mode = ',nb_mode
    518   write(lunout,*)' callnlte = ',callnlte
    519   write(lunout,*)' nltemodel = ',nltemodel
    520   write(lunout,*)' callnirco2 = ',callnirco2
    521   write(lunout,*)' nircorr = ',nircorr
    522   write(lunout,*)' callthermos = ',callthermos
    523   write(lunout,*)' solvarmod = ',solvarmod
    524   write(lunout,*)' solarcondate = ',solarcondate
    525   write(lunout,*)' euveff = ',euveff
     475  write(numout,*)' ##############################################'
     476  write(numout,*)' Configuration des parametres de la physique: '
     477  write(numout,*)' cycle_diurne = ', cycle_diurne
     478  write(numout,*)' soil_model = ', soil_model
     479  write(numout,*)' ok_orodr = ', ok_orodr
     480  write(numout,*)' ok_orolf = ', ok_orolf
     481  write(numout,*)' ok_gw_nonoro = ', ok_gw_nonoro
     482  write(numout,*)' nbapp_rad = ', nbapp_rad
     483  write(numout,*)' nbapp_chim = ', nbapp_chim
     484  write(numout,*)' iflag_con = ', iflag_con
     485  write(numout,*)' Sortie journaliere = ', ok_journe
     486  write(numout,*)' Sortie mensuelle = ', ok_mensuel
     487  write(numout,*)' Sortie instantanee = ', ok_instan
     488  write(numout,*)' frequence sorties = ', ecriphy 
     489  write(numout,*)' Sortie bilan d''energie, if_ebil =', if_ebil
     490  write(numout,*)' Excentricite = ',R_ecc
     491  write(numout,*)' Equinoxe = ',R_peri
     492  write(numout,*)' Inclinaison =',R_incl
     493  write(numout,*)' tr_scheme = ', tr_scheme
     494  write(numout,*)' iflag_pbl = ', iflag_pbl
     495  write(numout,*)' z0 = ',z0
     496  write(numout,*)' lmixmin = ',lmixmin
     497  write(numout,*)' ksta = ',ksta
     498  write(numout,*)' ok_kzmin = ',ok_kzmin
     499  write(numout,*)' inertie = ', inertie
     500  write(numout,*)' clmain = ',cclmain
     501  write(numout,*)' iflag_ajs = ', iflag_ajs
     502  write(numout,*)' lev_histins = ',lev_histins
     503  write(numout,*)' lev_histday = ',lev_histday
     504  write(numout,*)' lev_histmth = ',lev_histmth
     505  write(numout,*)' reinit_trac = ',reinit_trac
     506  write(numout,*)' ok_cloud = ',ok_cloud
     507  write(numout,*)' ok_chem = ',ok_chem
     508  write(numout,*)' ok_sedim = ',ok_sedim
     509  write(numout,*)' nb_mode = ',nb_mode
     510  write(numout,*)' callnlte = ',callnlte
     511  write(numout,*)' nltemodel = ',nltemodel
     512  write(numout,*)' callnirco2 = ',callnirco2
     513  write(numout,*)' nircorr = ',nircorr
     514  write(numout,*)' callthermos = ',callthermos
     515  write(numout,*)' solvarmod = ',solvarmod
     516  write(numout,*)' solarcondate = ',solarcondate
     517  write(numout,*)' euveff = ',euveff
    526518
    527519  return
    528 
     520!#endif
    529521  end subroutine conf_phys
    530522

  • trunk/LMDZ.VENUS/libf/phyvenus/load_ksi.F

    r1675 r1723  
    3838      character*9 tmp1
    3939      character*100 file
    40       CHARACTER*2 str2
     40      CHARACTER*3 str2
    4141      real   lambda(nnuve)            ! wavelenght in table (mu->m, middle of interval)
    4242      real   lambdamin(nnuve),lambdamax(nnuve) ! in microns
    … …  
    9999        endif
    100100c     Now reading ksi matrix index "mat"
    101         write(str2,'(i2.2)') m+2
     101        !write(str2,'(i2.2)') m+2
     102        write(str2,'(i3.3)') m+2
    102103        do band=1,Nb
    103104         read(10,*) lambdamin(band),lambdamax(band)

  • trunk/LMDZ.VENUS/libf/phyvenus/phys_state_var_mod.F90

    r1525 r1723  
    1010! Declaration des variables
    1111      USE dimphy
     12      USE turb_mod
    1213!      INTEGER, SAVE :: radpas
    1314!!$OMP THREADPRIVATE(radpas)
    … …  
    105106      REAL,save,allocatable :: fder(:) ! Derive de flux (sensible et latente)
    106107!$OMP THREADPRIVATE(dlw,fder)
    107 
    108108CONTAINS
    109109
    … …  
    117117      ALLOCATE(ftsoil(klon,nsoilmx))   ! temperature dans le sol
    118118      ALLOCATE(falbe(klon))            ! albedo
    119 
    120119!  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
    121120!
    … …  
    155154      ALLOCATE(topsw0(klon),toplw0(klon),solsw0(klon),sollw0(klon))
    156155      ALLOCATE(dlw(klon), fder(klon))
    157      
     156      allocate(sens(klon))     
     157      allocate(q2(klon,klev+1))
     158      allocate(l0(klon))
     159      allocate(wstar(klon))
     160      allocate(yustar(klon))
     161      allocate(tstar(klon))
     162      allocate(hfmax_th(klon))
     163      allocate(zmax_th(klon))
     164
    158165END SUBROUTINE phys_state_var_init
    159166
    … …  
    187194      deallocate(topsw0,toplw0,solsw0,sollw0)
    188195      deallocate(dlw, fder)
    189 
     196      deallocate(sens)
     197      deallocate(q2)
     198      deallocate(l0)
     199      deallocate(wstar)
     200      deallocate(yustar)
     201      deallocate(tstar)
     202      deallocate(hfmax_th)
     203      deallocate(zmax_th)
    190204END SUBROUTINE phys_state_var_end
    191205

  • trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F

    r1719 r1723  
    6565     &                       longitude_deg,latitude_deg, ! in degrees
    6666     &                       cell_area,dx,dy
    67       USE mod_phys_lmdz_para, only : is_parallel,jj_nb,
    68      &                               is_north_pole_phy,
    69      &                               is_south_pole_phy
    7067      USE phys_state_var_mod ! Variables sauvegardees de la physique
    71       USE write_field_phy
    72       USE iophy
    7368      USE cpdet_phy_mod, only: cpdet, t2tpot
    7469      USE chemparam_mod
    … …  
    8075      use infotrac_phy, only: iflag_trac, tname, ttext
    8176      use vertical_layers_mod, only: pseudoalt
    82       use mod_phys_lmdz_omp_data, ONLY: is_omp_master
     77      use turb_mod, only : sens, turb_resolved
    8378#ifdef CPP_XIOS     
    8479      use xios_output_mod, only: initialize_xios_output,
    … …  
    8782      use wxios, only: wxios_context_init, xios_context_finalize
    8883#endif
     84#ifdef MESOSCALE
     85      use comm_wrf
     86#else
     87      use iophy
     88      use write_field_phy
     89      use mod_phys_lmdz_omp_data, ONLY: is_omp_master
     90      USE mod_phys_lmdz_para, only : is_parallel,jj_nb,
     91     &                               is_north_pole_phy,
     92     &                               is_south_pole_phy
     93#endif
    8994      IMPLICIT none
    9095c======================================================================
    9196c   CLEFS CPP POUR LES IO
    9297c   =====================
     98#ifndef MESOSCALE
    9399c#define histhf
    94100#define histday
    95101#define histmth
    96102#define histins
     103#endif
    97104c======================================================================
    98105#include "dimsoil.h"
    … …  
    213220      REAL yv1(klon)            ! vents dans la premiere couche V
    214221
    215       REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
     222      REAL dsens(klon) ! derivee chaleur sensible
    216223      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
    217224      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
    … …  
    394401c cell_area for outputs in hist*
    395402      REAL cell_area_out(klon)
    396      
     403#ifdef MESOSCALE
     404      REAL :: dt_dyn(klev)
     405#endif
    397406c Declaration des constantes et des fonctions thermodynamiques
    398407c
    … …  
    409418      ballons  = 0
    410419! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!!
     420#ifndef MESOSCALE
    411421      if (is_parallel) then
    412422        bilansmc = 0
    413423        ballons  = 0
    414424      endif
    415 
     425#endif
    416426      IF (if_ebil.ge.1) THEN
    417427        DO i=1,klon
    … …  
    456466         itap    = 0
    457467         itaprad = 0
     468
     469#ifdef MESOSCALE
     470      print*,'check pdtphys',pdtphys
     471      PRINT*,'check phisfi ',pphis(1),pphis(klon)
     472      PRINT*,'check geop',pphi(1,1),pphi(klon,klev)
     473      PRINT*,'check radsol',radsol(1),radsol(klon)
     474      print*,'check ppk',ppk(1,1),ppk(klon,klev)
     475      print*,'check ftsoil',ftsoil(1,1),ftsoil(klon,nsoilmx)
     476      print*,'check ftsol',ftsol(1),ftsol(klon)
     477      print*, "check temp", t(1,1),t(klon,klev)
     478      print*, "check pres",paprs(1,1),paprs(klon,klev),pplay(1,1),
     479     .                     pplay(klon,klev)
     480      print*, "check u", u(1,1),u(klon,klev)
     481      print*, "check v", v(1,1),v(klon,klev)
     482      print*,'check falbe',falbe(1),falbe(klon)
     483      !nqtot=nqmax
     484      !ALLOCATE(tname(nqtot))
     485      !tname=noms
     486      zmea=0.
     487      zstd=0.
     488      zsig=0.
     489      zgam=0.
     490      zthe=0.
     491      dtime=pdtphys
     492#else
    458493c         
    459494c Lecture startphy.nc :
    … …  
    468503           ENDDO
    469504         ENDIF
     505#endif
    470506
    471507c dtime est defini dans tabcontrol.h et lu dans startphy
    … …  
    942978          if (cl_scheme.eq.1) then
    943979c         ================
    944 
     980#ifndef MESOSCALE
    945981           CALL new_cloud_sedim(
    946982     I                 klon,
    … …  
    10511087            d_tr_sed(:,:,iq) = d_tr_sed(:,:,iq) / dtime
    10521088           END DO
    1053 
     1089#endif
    10541090        endif
    10551091c         ====================
    … …  
    10701106c VENUS TEST: on ne tient pas compte des calculs de clmain mais on force
    10711107c l'equilibre radiatif du sol
    1072       if (1.eq.0) then
     1108      if (.not. cclmain) then
    10731109              if (debut) then
    10741110                print*,"ATTENTION, CLMAIN SHUNTEE..."
    … …  
    11191155      ENDDO
    11201156CXXX
    1121 
    1122       DO k = 1, klev
    1123       DO i = 1, klon
    1124          t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
    1125          d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
    1126          u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
    1127          d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
    1128          v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
    1129          d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
    1130       ENDDO
    1131       ENDDO
    1132 
     1157      IF (.not. turb_resolved) then !True only for LES
     1158        DO k = 1, klev
     1159        DO i = 1, klon
     1160           t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
     1161           d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
     1162           u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
     1163           d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
     1164           v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
     1165           d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
     1166        ENDDO
     1167        ENDDO
     1168      ENDIF
    11331169C TRACEURS
    11341170
    … …  
    17881824c   Ecriture des sorties
    17891825c=============================================================
    1790      
     1826#ifndef MESOSCALE      
    17911827#ifdef CPP_IOIPSL
    17921828
    … …  
    19011937
    19021938#endif
     1939#else
     1940! Outputs MESOSCALE
     1941      CALL allocate_comm_wrf(klon,klev)
     1942      comm_HR_SW(1:klon,1:klev) = dtsw(1:klon,1:klev)
     1943      comm_HR_LW(1:klon,1:klev) = dtlw(1:klon,1:klev)
     1944      comm_DT_RAD(1:klon,1:klev) = d_t_rad(1:klon,1:klev)
     1945      IF (turb_resolved) THEN
     1946        open(17,file='hrdyn.txt',form='formatted',status='old')
     1947        rewind(17)
     1948        DO k=1,klev
     1949          read(17,*) dt_dyn(k)
     1950        ENDDO
     1951        close(17)
     1952
     1953        do i=1,klon
     1954          d_t(i,:)=d_t(i,:)+dt_dyn(:)
     1955          comm_HR_DYN(i,:) = dt_dyn(:)
     1956        enddo
     1957       ELSE
     1958         comm_HR_DYN(1:klon,1:klev) = d_t_dyn(1:klon,1:klev)
     1959         comm_DT_VDF(1:klon,1:klev) = d_t_vdf(1:klon,1:klev)
     1960         comm_DT_AJS(1:klon,1:klev) = d_t_ajs(1:klon,1:klev)
     1961       ENDIF
     1962      comm_DT(1:klon,1:klev)=d_t(1:klon,1:klev)
     1963#endif
     1964
    19031965
    19041966c====================================================================

  • trunk/LMDZ.VENUS/libf/phyvenus/radlwsw.F

    r1687 r1723  
    5555
    5656      REAL   PPB(klev+1)
     57      REAL   PPA(klev)
    5758
    5859      REAL   zfract, zrmu0,latdeg
    … …  
    140141       DO k = 1, klev+1
    141142         PPB(k) = paprs(j,k)/1.e5
     143       ENDDO
     144       DO k = 1,klev
     145         PPA(k) = pplay(j,k)/1.e5
    142146       ENDDO
    143147
    … …  
    542546     .        ztoplw,zsollw,
    543547     .        zsollwdown,ZFLNET)
    544 
    545548c---------
    546549c SW call
    … …  
    561564      CALL SW_venus_rh(zrmu0,zfract,latdeg,
    562565c      CALL SW_venus_rh_1Dglobave(zrmu0,zfract,   ! pour moy globale
    563      S        PPB,temp,
     566     S        PPA,PPB,temp,
    564567     S        zheat,
    565568     S        ztopsw,zsolsw,ZFSNET)
    566      
    567569c======================================================================
    568570         radsol(j) = zsolsw - zsollw  ! + vers bas
    … …  
    599601         ENDDO
    600602      ENDIF ! callnlte
    601 
    602603      ENDDO ! of DO j = 1, klon
    603604c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++

  • trunk/LMDZ.VENUS/libf/phyvenus/sw_venus_rh.F

    r1621 r1723  
    11      SUBROUTINE SW_venus_rh(PRMU0, PFRAC, latdeg,
    2      S              PPB, pt,
     2     S              PPA, PPB, pt,
    33     S              PHEAT,
    44     S              PTOPSW,PSOLSW,ZFSNET)
    … …  
    3636      REAL   latdeg ! |latitude| (in degrees)
    3737      REAL   PPB(klev+1)  ! inter-couches PRESSURE (bar)
     38      REAL   PPA(klev)
    3839      REAL   pt(klev)     ! mid-layer temperature
    3940C
    … …  
    4142
    4243      REAL   PHEAT(klev)  ! SHORTWAVE HEATING (K/s) within each layer
     44      REAL   PHEATPPA(klev)
    4345      REAL   PTOPSW       ! SHORTWAVE FLUX AT T.O.A. (net)
    4446      REAL   PSOLSW       ! SHORTWAVE FLUX AT SURFACE (net)
    … …  
    5355      parameter (nlatrh=19) ! fichiers Rainer Haus
    5456     
    55       integer i,j,lat,nsza,nsza0(2),nl0,nlat0
     57      integer i,j,k,lat,nsza,nsza0(2),nl0,nlat0
    5658      real   zsnet(nlrh+1,nszarh+1,nlatrh+1)! net solar flux (W/m**2) (+ vers bas)
    5759      real   solza(nszarh,nlatrh)       ! solar zenith angles in table
    5860      real   presrh(nlrh+1)             ! pressure in table (bar)
     61      real   logplaydc(nlrh)
    5962      real   altrh(nlrh+1)              ! altitude in table (km)
    6063      real   latrh(nlatrh)              ! latitude in table (degrees)
    … …  
    6669      save   solza,zsnet,altrh,latrh,presrh
    6770      save   firstcall
     71      real   Tplay(nlrh)
     72      real   Qdc1(nlrh)
     73      real   Qdc2(nlrh)
     74      real   Qdc3(nlrh)
     75      real   Qdc4(nlrh)
    6876     
    6977c ------------------------
    7078c Loading the file
    7179c ------------------------
    72 
    7380      if (firstcall) then
    7481
    … …  
    116123         endif
    117124      enddo
    118      
     125
    119126      if (nlat0.ne.nlatrh+1) then
    120127        factlat = (latdeg-latrh(nlat0-1))/(latrh(nlat0)-latrh(nlat0-1))
    … …  
    127134     
    128135      sza0 = acos(PRMU0)/3.1416*180.
    129 c        print*,'Angle Zenithal =',sza0,' PFRAC=',PFRAC
    130136      nsza0(:)=2
    131137
    … …  
    135141         endif
    136142      enddo
    137      
    138143      if (nsza0(1).ne.nszarh+1) then
    139144          factsza(1) = (sza0-solza(nsza0(1)-1,nlat0-1))/
    … …  
    143148     .         (90.-solza(nszarh,nlat0-1)), 1.)
    144149      endif
    145 
    146150      if (nlat0.ne.nlatrh+1) then
    147151       do nsza=1,nszarh
    … …  
    150154         endif
    151155       enddo
    152      
    153156       if (nsza0(2).eq.nszarh+1) then
    154157          factsza(2) = min((sza0-solza(nszarh,nlat0))/
    … …  
    164167        factsza(2) = 1.
    165168      endif
    166 
    167169c Pressure levels
    168170c ---------------
    169 
    170171      do j=1,klev+1
    171172        nl0 = nlrh
    … …  
    193194       
    194195      enddo
    195 
    196196      PTOPSW = ZFSNET(klev+1)
    197197      PSOLSW = ZFSNET(1)
    198      
     198
     199#ifdef MESOSCALE
     200! extrapolation play DCrisp pressure
     201      do j=1,nlrh
     202         logplaydc(j)=(log(presrh(j+1))+log(presrh(j)))/2.
     203      enddo
     204! Extrapolation of temperature over DCrisp play pressure
     205      do i=nlrh,2,-1
     206        nl0 = 2
     207        do j=1,klev-1
     208           if (exp(logplaydc(i)).le.PPA(j)) then
     209                nl0 = j+1
     210           endif
     211        enddo
     212        factflux = (log10(max(exp(logplaydc(i)),PPA(klev)))
     213     .                         -log10(PPA(nl0-1)))
     214     .       /(log10(PPA(nl0))-log10(PPA(nl0-1)))
     215        Tplay(i)=factflux*pt(nl0)
     216     .             + (1.-factflux)*pt(nl0-1)
     217
     218      ENDDO
     219! DCrisp PHEAT over DCrisp play pressure
     220      DO k=1,nlrh
     221c
     222       Qdc1(k)=((RG/cpdet(Tplay(k)))
     223     .     *((zsnet(k+1,nsza0(1),nlat0-1)-zsnet(k,nsza0(1),nlat0-1))
     224     .         *PFRAC))
     225     .      /((presrh(k)-presrh(k+1))*1.e5)
     226       Qdc2(k)=((RG/cpdet(Tplay(k)))
     227     . *((zsnet(k+1,nsza0(1)-1,nlat0-1)-zsnet(k,nsza0(1)-1,nlat0-1))
     228     .         *PFRAC))
     229     .      /((presrh(k)-presrh(k+1))*1.e5)
     230       Qdc3(k)=((RG/cpdet(Tplay(k)))
     231     .       *((zsnet(k+1,nsza0(2),nlat0)-zsnet(k,nsza0(2),nlat0))
     232     .         *PFRAC))
     233     .      /((presrh(k)-presrh(k+1))*1.e5)
     234       Qdc4(k)=((RG/cpdet(Tplay(k)))
     235     .       *((zsnet(k+1,nsza0(2)-1,nlat0)-zsnet(k,nsza0(2)-1,nlat0))
     236     .        *PFRAC))
     237     .      /((presrh(k)-presrh(k+1))*1.e5)
     238      ENDDO
     239! Interapolation of PHEAT over GCM/MESOSCALE play lelv
     240      do j=1,klev
     241        nl0 = nlrh-1
     242        do i=nlrh,2,-1
     243           if (exp(logplaydc(i)).ge.PPA(j)) then
     244                nl0 = i-1
     245           endif
     246        enddo
     247c        factflux = (log10(max(PPB(j),presrh(1)))-log10(presrh(nl0+1)))
     248c     .            /(log10(presrh(nl0))-log10(presrh(nl0+1)))
     249        factflux = (log10(max(PPA(j),exp(logplaydc(1))))
     250     .                         -log10(exp(logplaydc(nl0+1))))
     251     .     /(log10(exp(logplaydc(nl0)))-log10(exp(logplaydc(nl0+1))))
     252        PHEATPPA(j)=factlat*(
     253     .      factflux   *  factsza(2)  *Qdc3(nl0)
     254     . +   factflux   *(1.-factsza(2))*Qdc4(nl0)
     255     . + (1.-factflux)*  factsza(2)   *Qdc3(nl0+1)
     256     . + (1.-factflux)*(1.-factsza(2))*Qdc4(nl0+1))
     257     .            + (1.-factlat)*(
     258     .      factflux   *  factsza(1)   *Qdc1(nl0)
     259     . +   factflux   *(1.-factsza(1))*Qdc2(nl0)
     260     . + (1.-factflux)*  factsza(1)   *Qdc1(nl0+1)
     261     . + (1.-factflux)*(1.-factsza(1))*Qdc2(nl0+1) )
     262        PHEAT(j)=PHEATPPA(j)
     263      ENDDO
     264
     265
     266#else     
    199267c Heating rates
    200268c -------------
    … …  
    207275      do j=1,klev
    208276! ADAPTATION GCM POUR CP(T)
    209         PHEAT(j) = (ZFSNET(j+1)-ZFSNET(j))
     277         PHEAT(j) = PHEATPPA(j)
    210278     .            *RG/cpdet(pt(j)) / ((PPB(j)-PPB(j+1))*1.e5)
    211279c-----TEST-------
    212280c tayloring the solar flux...
    213281        if ((PPB(j).gt.1.4).and.(PPB(j).le.10.)) then
    214           PHEAT(j) = PHEAT(j)*3
    215         endif
     282         PHEAT(j) = PHEAT(j)*3
     283!        endif
    216284c----------------
    217       enddo
     285!      enddo
     286#endif
     287     
    218288
    219289      return

  • trunk/LMDZ.VENUS/libf/phyvenus/yamada4.F

    r1530 r1723  
    88c.......................................................................
    99      use dimphy
     10      use turb_mod, only: q2,l0
    1011      IMPLICIT NONE
    1112c.......................................................................
    … …  
    8182      real m2cstat,mcstat,kmcstat
    8283      real l(klon,klev+1)
    83       real,save,allocatable :: l0(:)
     84      !real,save,allocatable :: l0(:)
    8485c  ATTENTION! mis ici car j'ai enlevé q2 des arguments...
    8586c   sinon, c'est au-dessus que ça se passe...
    86       REAL,save,allocatable :: q2(:,:)
     87      !REAL,save,allocatable :: q2(:,:)
    8788
    8889      real sq(klon),sqz(klon),zz(klon,klev+1)
    … …  
    117118
    118119      if (first) then
    119         allocate(l0(klon))
    120         allocate(q2(klon,klevp1))
     120        IF (.not.ALLOCATED(l0)) allocate(l0(klon))
     121        IF (.not.ALLOCATED(q2)) allocate(q2(klon,klevp1))
    121122
    122123c (surtout pour k=1, à cause diagnostiques...)
Note: See TracChangeset for help on using the changeset viewer.