Ignore:
Timestamp:
Jul 17, 2013, 11:24:04 AM (11 years ago)
Author:
Ehouarn Millour
Message:

Ré-implémentation des commissions écrasées par la rev 1785. (Notamment lmdz1d.F)
UG
...................................................

Reimplementation of the commitions undonned by rev 1785. (Especially lmdy1d.F)
UG

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phy1d/lmdz1d.F

    r1785 r1790  
    22
    33      USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
    4       USE phys_state_var_mod
    5       USE comgeomphy
    6       USE dimphy
    7       USE surface_data, only : type_ocean,ok_veget
    8       USE pbl_surface_mod, only : pbl_surface_init, pbl_surface_final
    9       USE fonte_neige_mod, only : fonte_neige_init, fonte_neige_final
    10 
    11       USE infotrac ! new
    12       USE control_mod
     4      use phys_state_var_mod
     5      use comgeomphy
     6      use dimphy
     7      use surface_data, only : type_ocean,ok_veget
     8      use pbl_surface_mod, only : ftsoil, pbl_surface_init,
     9     $                            pbl_surface_final
     10      use fonte_neige_mod, only : fonte_neige_init, fonte_neige_final
     11
     12      use infotrac ! new
     13      use control_mod
    1314      USE indice_sol_mod
    1415
    … …  
    2627#include "compar1d.h"
    2728#include "flux_arp.h"
     29#include "tsoilnudge.h"
    2830#include "fcg_gcssold.h"
    2931!!!#include "fbforcing.h"
    … …  
    8789
    8890        integer :: kmax = llm
    89         integer nlev_max
    90         parameter (nlev_max = 100)
     91        integer nlev_max,llm700
     92        parameter (nlev_max = 1000)
    9193        real timestep, frac, timeit
    9294        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max),
    … …  
    99101c        integer :: forcing_type
    100102        logical :: forcing_les     = .false.
    101         logical :: forcing_armcu  = .false.
     103        logical :: forcing_armcu   = .false.
    102104        logical :: forcing_rico    = .false.
    103105        logical :: forcing_radconv = .false.
    104106        logical :: forcing_toga    = .false.
    105107        logical :: forcing_twpice  = .false.
     108        logical :: forcing_amma    = .false.
    106109        logical :: forcing_GCM2SCM = .false.
    107110        logical :: forcing_GCSSold = .false.
     111        logical :: forcing_sandu   = .false.
     112        logical :: forcing_astex   = .false.
     113        logical :: forcing_fire    = .false.
    108114        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
    109115!                                                            (cf read_tsurf1d.F)
    110116
    111117!vertical advection computation
    112         real d_t_z(llm), d_q_z(llm)
    113         real d_t_dyn_z(llm), d_q_dyn_z(llm)
    114         real zz(llm)
    115         real zfact
     118!       real d_t_z(llm), d_q_z(llm)
     119!       real d_t_dyn_z(llm), d_q_dyn_z(llm)
     120!       real zz(llm)
     121!       real zfact
    116122
    117123!flag forcings
    … …  
    130136      real :: pzero=1.e5
    131137      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
    132       real :: playd(llm),zlayd(llm)
     138      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1),poub
    133139
    134140!---------------------------------------------------------------------
    … …  
    138144      integer :: iq
    139145      real :: phi(llm)
     146      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
    140147      real :: rlat_rad(1),rlon_rad(1)
    141       real :: teta(llm),temp(llm),u(llm),v(llm)
    142148      real :: omega(llm+1),omega2(llm),rho(llm+1)
    143149      real :: ug(llm),vg(llm),fcoriolis
    … …  
    197203!  Fichiers et d'autres variables
    198204!---------------------------------------------------------------------
    199       real ttt
     205      real ttt,bow,q1
    200206      integer :: ierr,k,l,i,it=1,mxcalc
    201207      integer jjmp1
    … …  
    253259!             initial profiles from RICO files
    254260!             LS convergence imposed from RICO files
     261!forcing_type = 6 ==> forcing_amma = .true.
     262!             initial profiles from AMMA nc file
     263!             LS convergence, omega and surface fluxes imposed from AMMA file 
    255264!forcing_type = 40 ==> forcing_GCSSold = .true.
    256265!             initial profile from GCSS file
    257266!             LS convergence imposed from GCSS file
     267!forcing_type = 59 ==> forcing_sandu = .true.
     268!             initial profiles from sanduref file: see prof.inp.001
     269!             SST varying with time and divergence constante: see ifa_sanduref.txt file
     270!             Radiation has to be computed interactively
     271!forcing_type = 60 ==> forcing_astex = .true.
     272!             initial profiles from file: see prof.inp.001
     273!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
     274!             Radiation has to be computed interactively
    258275!forcing_type = 61 ==> forcing_armcu = .true.
    259 !             initial profile from arm_cu file
    260 !             LS convergence imposed from arm_cu file
     276!             initial profiles from file: see prof.inp.001
     277!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
     278!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
     279!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s
     280!             Radiation to be switched off
    261281!
    262282      if (forcing_type .eq.0) THEN
    … …  
    272292      elseif (forcing_type .eq.5) THEN
    273293       forcing_rico = .true.
     294      elseif (forcing_type .eq.6) THEN
     295       forcing_amma = .true.
    274296      elseif (forcing_type .eq.40) THEN
    275297       forcing_GCSSold = .true.
     298      elseif (forcing_type .eq.59) THEN
     299       forcing_sandu   = .true.
     300      elseif (forcing_type .eq.60) THEN
     301       forcing_astex   = .true.
    276302      elseif (forcing_type .eq.61) THEN
    277303       forcing_armcu = .true.
    … …  
    279305      else
    280306       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
    281        stop 'Forcing_type should be 0,1,2,3 or 40'
     307       stop 'Forcing_type should be 0,1,2,3,4,5,6 or 40,59,60,61'
    282308      ENDIF
    283309      print*,"forcing type=",forcing_type
    … …  
    289315
    290316        type_ts_forcing = 0
    291         if (forcing_toga) type_ts_forcing = 1
     317        if (forcing_toga .or. forcing_sandu .or. forcing_astex)
     318     :    type_ts_forcing = 1
    292319
    293320!---------------------------------------------------------------------
    … …  
    328355c Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
    329356      IF(forcing_type .EQ. 61) fnday=53100./86400.
     357c Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
     358      IF(forcing_type .EQ. 6) fnday=64800./86400.
    330359      annee_ref = anneeref
    331360      mois = 1
    … …  
    337366      day_ini = day
    338367      day_end = day_ini + nday
     368
     369      IF (forcing_type .eq.2) THEN
    339370! Convert the initial date of Toga-Coare to Julian day
    340371      call ymds2ju
    341372     $ (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
    342373
     374      ELSEIF (forcing_type .eq.4) THEN
    343375! Convert the initial date of TWPICE to Julian day
    344376      call ymds2ju
    345377     $ (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi
    346378     $ ,day_ju_ini_twpi)
    347 
    348 ! Convert the initial date of Arm_cu to Julian day
     379      ELSEIF (forcing_type .eq.6) THEN
     380! Convert the initial date of AMMA to Julian day
     381      call ymds2ju
     382     $ (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma
     383     $ ,day_ju_ini_amma)
     384
     385      ELSEIF (forcing_type .eq.59) THEN
     386! Convert the initial date of Sandu case to Julian day
     387      call ymds2ju
     388     $   (year_ini_sandu,mth_ini_sandu,day_ini_sandu,
     389     $    time_ini*3600.,day_ju_ini_sandu)
     390
     391      ELSEIF (forcing_type .eq.60) THEN
     392! Convert the initial date of Astex case to Julian day
     393      call ymds2ju
     394     $   (year_ini_astex,mth_ini_astex,day_ini_astex,
     395     $    time_ini*3600.,day_ju_ini_astex)
     396
     397      ELSEIF (forcing_type .eq.61) THEN
     398
     399! Convert the initial date of Arm_cu case to Julian day
    349400      call ymds2ju
    350401     $ (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu
    351402     $ ,day_ju_ini_armcu)
     403      ENDIF
    352404
    353405      daytime = day + time_ini/24. ! 1st day and initial time of the simulation
    … …  
    436488ccc      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
    437489
     490      IF (forcing_type .eq. 59) THEN
     491! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
    438492      write(*,*) '***********************'
    439493      do l = 1, llm
    440494       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
     495       if (trouve_700 .and. play(l).le.70000) then
     496         llm700=l
     497         print *,'llm700,play=',llm700,play(l)/100.
     498         trouve_700= .false.
     499       endif
    441500      enddo
    442501      write(*,*) '***********************'
     502      ENDIF
    443503
    444504c
    … …  
    516576        agesno  = xagesno
    517577        tsoil(:,:,:)=tsurf
     578!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
     579!       tsoil(1,1,1)=299.18
     580!       tsoil(1,2,1)=300.08
     581!       tsoil(1,3,1)=301.88
     582!       tsoil(1,4,1)=305.48
     583!       tsoil(1,5,1)=308.00
     584!       tsoil(1,6,1)=308.00
     585!       tsoil(1,7,1)=308.00
     586!       tsoil(1,8,1)=308.00
     587!       tsoil(1,9,1)=308.00
     588!       tsoil(1,10,1)=308.00
     589!       tsoil(1,11,1)=308.00
     590!-----------------------------------------------------------------------
    518591        call pbl_surface_init(qsol, fder, snsrf, qsurfsrf,
    519592     &                                    evap, frugs, agesno, tsoil)
    … …  
    749822       endif
    750823
    751        if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice) then
     824       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice
     825     :    .or.forcing_amma) then
    752826         fcoriolis=0.0 ; ug=0. ; vg=0.
    753827       endif
    … …  
    814888
    815889        teta=temp*(pzero/play)**rkappa
     890!
     891!---------------------------------------------------------------------
     892!   Nudge soil temperature if requested
     893!---------------------------------------------------------------------
     894
     895      IF (nudge_tsoil) THEN
     896       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)
     897     .  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
     898      ENDIF
    816899
    817900!---------------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.