Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (11 months ago)
Author:
abarral
Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
Files:
1 deleted
14 edited
2 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h

    r5135 r5158  
    1313        REAL dt_toga
    1414        parameter (dt_toga=6.*3600.)
    15 !!
     15
    1616        INTEGER year_print, month_print, day_print
    1717        real    sec_print
    18 !!
     18
    1919        REAL ts_toga(nt_toga)
    2020        REAL plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
    … …  
    3333        REAL w_mod(llm), t_mod(llm),q_mod(llm)
    3434        REAL u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
    35             real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)       
     35        real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)
    3636        REAL hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
    3737        REAL th_mod(llm)
    3838
    39 ! EV comment these lines
    40 !        real ts_cur
    41 !        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
    4239!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4340! Declarations specifiques au cas RICO
    … …  
    188185        real  dtime_frcg
    189186        LOGICAL :: Turb_fcg_gcssold
    190 
    191         common /turb_forcing/                                                   &
    192         dtime_frcg,hthturb_gcssold, hqturb_gcssold,Turb_fcg_gcssold
    193187!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    194188! Declarations specifiques au cas Arm_cu

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h

    r5128 r5158  
    8888      else
    8989         DO l=2,llm-1
    90             IF (omega(l)>0.) THEN
     90        IF (omega(l)>0.) THEN
    9191             d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
    9292             d_th_z(l)=(teta(l+1)-teta(l))/(play(l+1)-play(l))
    … …  
    9494             d_u_z(l)=(u(l+1)-u(l))/(play(l+1)-play(l))
    9595             d_v_z(l)=(v(l+1)-v(l))/(play(l+1)-play(l))
    96             ELSE
     96        ELSE
    9797             d_t_z(l)=(temp(l-1)-temp(l))/(play(l-1)-play(l))
    9898             d_th_z(l)=(teta(l-1)-teta(l))/(play(l-1)-play(l))
    … …  
    100100             d_u_z(l)=(u(l-1)-u(l))/(play(l-1)-play(l))
    101101             d_v_z(l)=(v(l-1)-v(l))/(play(l-1)-play(l))
    102             ENDIF
    103         ENDDO
     102        ENDIF
     103    ENDDO
    104104      endif
    105105      d_t_z(1)=d_t_z(2)
    … …  
    116116
    117117! TRAVAIL : PRENDRE DES NOTATIONS COHERENTES POUR W
    118       do l = 1, llm
     118      DO l = 1, llm
    119119! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
    120         PRINT*, l, llm
    121         PRINT*, play(l), temp(l)
     120    PRINT*, l, llm
     121    PRINT*, play(l), temp(l)
    122122       omega(l) = -w_mod_cas(l)*play(l)*rg/(rd*temp(l))
    123123      enddo
    … …  
    133133!geostrophic wind
    134134      IF (forc_geo.EQ.1) THEN
    135         do l=1,llm
     135        DO l=1,llm
    136136        ug(l) = ug_mod_cas(l)
    137137        vg(l) = vg_mod_cas(l)
    … …  
    139139      endif
    140140
    141       do l = 1, llm
     141      DO l = 1, llm
    142142
    143143!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h

    r5128 r5158  
    1616         CALL read_SCM_cas
    1717         WRITE(*,*) 'Forcing read'
    18         PRINT*,'PS ps_cas',ps_cas
     18    PRINT*,'PS ps_cas',ps_cas
    1919
    2020!Time interpolation for initial conditions using interpolation routine
    … …  
    4444             ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    4545
    46       do l = 1, nlev_cas
     46      DO l = 1, nlev_cas
    4747      print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
    4848      enddo
    … …  
    9292
    9393
    94       do l = 1, llm
     94      DO l = 1, llm
    9595       temp(l) = t_mod_cas(l)
    9696       q(l,1) = qv_mod_cas(l)
    … …  
    119119! Etienne pour initialisation de TKE
    120120
    121        do l=1,llm+1
     121       DO l=1,llm+1
    122122       pbl_tke(:,l,:)=tke_mod_cas(l)
    123123       enddo     

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

    r5153 r5158  
    44          disvert0, advect_vert, advect_va, lstendh, nudge_rht_init, nudge_uv_init, &
    55          nudge_rht, nudge_uv, interp2_case_vertical
     6
    67CONTAINS
    78  REAL FUNCTION fq_sat(kelvin, millibar)
    … …  
    6768    USE lmdz_fcs_gcssold, ONLY: imp_fcg_gcssold, ts_fcg_gcssold, Tp_fcg_gcssold, Tp_ini_gcssold, xTurb_fcg_gcssold
    6869    USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
     70    USE lmdz_compar1d
     71
     72    IMPLICIT NONE
    6973    !-----------------------------------------------------------------------
    7074    !     Auteurs :   A. Lahellec  .
    71 
    72     !   Declarations :
    73     !   --------------
    74 
    75     include "compar1d.h"
    76     include "fcg_racmo.h"
    77 
    78 
    79     !   local:
    80     !   ------
    81 
    82     !      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
    8375
    8476    !  -------------------------------------------------------------------
    … …  
    11481140    !---------------------------------------------------------------
    11491141
    1150     do l = 1, llm
     1142    DO l = 1, llm
    11511143      zw(l) = dt * w(l)
    11521144      zm(l) = plev(l) - plev(l + 1)
    … …  
    11561148    zw(llm + 1) = 0.
    11571149
    1158     do l = 1, llm
     1150    DO l = 1, llm
    11591151      qold = q(l)
    11601152      q(l) = (q(l) * zm(l) + zwq(l + 1) - zwq(l)) / (zm(l) + zw(l + 1) - zw(l))
    … …  
    11861178    REAL alpha, omgdown, omgup
    11871179
    1188     do l = 1, llm
     1180    DO l = 1, llm
    11891181      IF(l==1) THEN
    11901182        !si omgup pour la couche 1, alors tendance nulle
    … …  
    12711263    cor(:) = rkappa * temp * (1. + q(:, 1) * rv / rd) / (play * (1. + q(:, 1)))
    12721264
    1273     do k = 2, llm - 1
     1265    DO k = 2, llm - 1
    12741266
    12751267      dph  (k - 1) = (play(k) - play(k - 1))
    … …  
    12861278    dtdp (llm) = dtdp (llm - 1)
    12871279
    1288     do k = 2, llm - 1
     1280    DO k = 2, llm - 1
    12891281      omdn = max(0.0, omega(k + 1))
    12901282      omup = min(0.0, omega(k))
    … …  
    13251317
    13261318    IMPLICIT NONE
    1327  INCLUDE "FCTTRE.h"
     1319    INCLUDE "FCTTRE.h"
    13281320
    13291321    ! ========================================================
    … …  
    13991391
    14001392    IMPLICIT NONE
    1401  INCLUDE "FCTTRE.h"
     1393    INCLUDE "FCTTRE.h"
    14021394
    14031395    ! ========================================================
    … …  
    15931585    !      enddo
    15941586
    1595     do l = 1, llm
     1587    DO l = 1, llm
    15961588
    15971589      IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
    … …  
    16021594
    16031595        IF (play(l)<=plev_prof_cas(1)) THEN
    1604           do k = 1, nlev_cas - 1
     1596          DO k = 1, nlev_cas - 1
    16051597            IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
    16061598              k1 = k
    … …  
    16121604            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
    16131605            WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
    1614             do k = 1, nlev_cas - 1
     1606            DO k = 1, nlev_cas - 1
    16151607              WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
    16161608            enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_compar1d.f90

    r5157 r5158  
     1MODULE lmdz_compar1d
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC  nat_surf, tsurf, beta_surf, rugos, rugosh, &
     4          xqsol, qsurf, psurf, zsurf, albedo, time, time_ini, xlat, xlon, airefi, &
     5          wtsurf, wqsurf, restart_runoff, xagesno, qsolinp, zpicinp, &
     6          forcing_type, tend_u, tend_v, tend_w, tend_t, tend_q, tend_rayo, &
     7          nudge_u, nudge_v, nudge_w, nudge_t, nudge_q, &
     8          iflag_nudge, snowmass, &
     9          restart, ok_old_disvert, &
     10          tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
     11          trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
     12          nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w, &
     13          p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
    114
    2 ! $Id: compar1d.h 2010-08-04 17:02:56Z lahellec $
     15  INTEGER :: forcing_type
     16  INTEGER :: tend_u, tend_v, tend_w, tend_t, tend_q, tend_rayo
     17  REAL :: nudge_u, nudge_v, nudge_w, nudge_t, nudge_q
     18  INTEGER :: iflag_nudge
     19  REAL :: nat_surf
     20  REAL :: tsurf
     21  REAL :: beta_surf
     22  REAL :: rugos
     23  REAL :: rugosh
     24  REAL :: xqsol(1:2)
     25  REAL :: qsurf
     26  REAL :: psurf
     27  REAL :: zsurf
     28  REAL :: albedo
     29  REAL :: snowmass
    330
    4       INTEGER :: forcing_type
    5       INTEGER :: tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo
    6       REAL :: nudge_u,nudge_v,nudge_w,nudge_t,nudge_q
    7       INTEGER :: iflag_nudge
    8       REAL :: nat_surf
    9       REAL :: tsurf
    10       REAL :: beta_surf
    11       REAL :: rugos
    12       REAL :: rugosh
    13       REAL :: xqsol(1:2)
    14       REAL :: qsurf
    15       REAL :: psurf
    16       REAL :: zsurf
    17       REAL :: albedo
    18       REAL :: snowmass
     31  REAL :: time
     32  REAL :: time_ini
     33  REAL :: xlat
     34  REAL :: xlon
     35  REAL :: airefi
     36  REAL :: wtsurf
     37  REAL :: wqsurf
     38  REAL :: restart_runoff
     39  REAL :: xagesno
     40  REAL :: qsolinp
     41  REAL :: zpicinp
    1942
    20       REAL :: time
    21       REAL :: time_ini
    22       REAL :: xlat
    23       REAL :: xlon
    24       REAL :: airefi
    25       REAL :: wtsurf
    26       REAL :: wqsurf
    27       REAL :: restart_runoff
    28       REAL :: xagesno
    29       REAL :: qsolinp
    30       REAL :: zpicinp
     43  LOGICAL :: restart
     44  LOGICAL :: ok_old_disvert
    3145
    32       LOGICAL :: restart
    33       LOGICAL :: ok_old_disvert
     46  ! Pour les forcages communs: ces entiers valent 0 ou 1
     47  ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
     48  ! idem pour l advection en theta
     49  ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
     50  ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
     51  ! forcages en omega, w, vent geostrophique ou ustar
     52  ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
    3453
    35 ! Pour les forcages communs: ces entiers valent 0 ou 1
    36 ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
    37 ! idem pour l advection en theta
    38 ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
    39 ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
    40 ! forcages en omega, w, vent geostrophique ou ustar
    41 ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
    42 
    43       INTEGER :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
    44       INTEGER :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
    45       real    :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_qv
    46       real    :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
    47       common/com_par1d/                                                 &
    48        nat_surf,tsurf,beta_surf,rugos,rugosh,                           &
    49        xqsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,   &
    50        wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
    51        forcing_type,tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo,       &
    52        nudge_u,nudge_v,nudge_w,nudge_t,nudge_q,                         &
    53        iflag_nudge,snowmass,                                            &
    54        restart,ok_old_disvert,                                          &
    55        tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh,   &
    56        trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar,  &
    57        nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w,          &
    58        p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
    59 
    60 !$OMP THREADPRIVATE(/com_par1d/)
     54  INTEGER :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
     55  INTEGER :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
     56  REAL :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_qv
     57  REAL :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
    6158
    6259
     60  !$OMP THREADPRIVATE(nat_surf, tsurf, beta_surf, rugos, rugosh, &
     61  !$OMP      xqsol, qsurf, psurf, zsurf, albedo, time, time_ini, xlat, xlon, airefi, &
     62  !$OMP      wtsurf, wqsurf, restart_runoff, xagesno, qsolinp, zpicinp, &
     63  !$OMP      forcing_type, tend_u, tend_v, tend_w, tend_t, tend_q, tend_rayo, &
     64  !$OMP      nudge_u, nudge_v, nudge_w, nudge_t, nudge_q, &
     65  !$OMP      iflag_nudge, snowmass, &
     66  !$OMP      restart, ok_old_disvert, &
     67  !$OMP      tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
     68  !$OMP      trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
     69  !$OMP      nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w, &
     70  !$OMP      p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w)
    6371
    64 
    65 
    66 
    67 
    68 
    69 
    70 
    71 
     72END MODULE lmdz_compar1d

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_date_cas.f90

    r5157 r5158  
    1       INTEGER :: year_ini_cas    ! initial year of the case
    2       INTEGER :: mth_ini_cas     ! initial month of the case
    3       INTEGER :: day_deb         ! initial day of the case
    4       REAL :: heure_ini_cas      ! start time of the case
    5       REAL :: pdt_cas            ! forcing_frequency
    6       REAL :: day_ju_ini_cas     ! julian day of initial day of the case
     1MODULE lmdz_date_cas
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
    74
    8       common /date_cas/year_ini_cas,mth_ini_cas,day_deb,heure_ini_cas,pdt_cas,day_ju_ini_cas
     5  INTEGER :: year_ini_cas    ! initial year of the case
     6  INTEGER :: mth_ini_cas     ! initial month of the case
     7  INTEGER :: day_deb         ! initial day of the case
     8  REAL :: heure_ini_cas      ! start time of the case
     9  REAL :: pdt_cas            ! forcing_frequency
     10  REAL :: day_ju_ini_cas     ! julian day of initial day of the case
     11END MODULE lmdz_date_cas
    912

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

    r5144 r5158  
    22  PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
    33  PUBLIC get_uvd, copie, get_uvd2, rdgrads, spaces
     4
     5  REAL play(100)  !pression en Pa au milieu de chaque couche GCM
     6  INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
     7  REAL coef1(100) !coefficient d interpolation
     8  REAL coef2(100) !coefficient d interpolation
     9  INTEGER klev
     10
     11  INTEGER nblvlm !nombre de niveau de pression du mesoNH
     12  REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
     13  REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
     14
     15
    416CONTAINS
    517
    … …  
    1628    ! pouvoir calculer la convergence et le cisaillement dans la physiq
    1729    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    18 
    19     INTEGER klev
    20     REAL play(100)  !pression en Pa au milieu de chaque couche GCM
    21     INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
    22     REAL coef1(100) !coefficient d interpolation
    23     REAL coef2(100) !coefficient d interpolation
    24 
    25     INTEGER nblvlm !nombre de niveau de pression du mesoNH
    26     REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
    27     REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
    28 
    2930    INTEGER i, j, k, ll, in
    30 
    3131    CHARACTER*80 file_forctl, file_fordat
    32 
    33     COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
    34     COMMON/com2_phys_gcss/playm, hplaym, nblvlm
    3532
    3633    !======================================================================
    … …  
    162159    !*** precedent en format gcm                                     ***
    163160    IF(pas>pasprev)THEN
    164       do i = 1, klev
     161      DO i = 1, klev
    165162        htbef(i) = htaft(i)
    166163        hqbef(i) = hqaft(i)
    … …  
    192189      IF(Tp_fcg) THEN
    193190        !     (le forcage est donne en temperature potentielle)
    194         do i = 1, nblvlm
     191        DO i = 1, nblvlm
    195192          ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
    196193        enddo
    197194      endif ! Tp_fcg
    198195      IF(Turb_fcg) THEN
    199         do i = 1, nblvlm
     196        DO i = 1, nblvlm
    200197          hThTurb_mes(i) = hThTurb_mes(i) * (hplaym(i) / 1000.)**rkappa
    201198        enddo
    … …  
    216213      !*** on interpole les champs meso_NH sur les niveaux de pression***
    217214      !*** gcm . on obtient le nouveau champ after                    ***
    218       do k = 1, klev
     215      DO k = 1, klev
    219216        IF (JM(k) == 0) THEN
    220217          htaft(k) = ht_mes(jm(k) + 1)
    … …  
    254251    !*** on conserve les derniers champs calcules                    ***
    255252    IF(temps>=pasmax)THEN
    256       do ll = 1, klev
     253      DO ll = 1, klev
    257254        ht(ll) = htaft(ll)
    258255        hq(ll) = hqaft(ll)
    … …  
    267264      !*** on interpole sur les pas de temps de 10mn du gcm a partir   ***
    268265      !** des pas de temps de 1h du meso_NH                            ***
    269       do j = 1, klev
     266      DO j = 1, klev
    270267        ht(j) = ((timeaft - time) * htbef(j) + (time - timebef) * htaft(j)) / dt
    271268        hq(j) = ((timeaft - time) * hqbef(j) + (time - timebef) * hqaft(j)) / dt
    … …  
    287284    print *, ' time,timebef,timeaft', time, timebef, timeaft
    288285    print *, ' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
    289     do j = 1, klev
     286    DO j = 1, klev
    290287      print *, j, ht(j), htbef(j), htaft(j), &
    291288              &             hthturb(j), hthturbbef(j), hthturbaft(j)
    292289    enddo
    293290    print *, ' hq,hqbef,hqaft,hqturb,hqturbbef,hqturbaft'
    294     do j = 1, klev
     291    DO j = 1, klev
    295292      print *, j, hq(j), hqbef(j), hqaft(j), &
    296293              &             hqturb(j), hqturbbef(j), hqturbaft(j)
    … …  
    317314
    318315    !------------------
    319     do i = 1, 1000
     316    DO i = 1, 1000
    320317      read(97, 1000, end = 999) string
    321318      1000 format (a4)
    … …  
    373370    !------------------------------------------------------------------------
    374371    IF(Tp_fcg) THEN
    375       do i = 1, nblvlm
     372      DO i = 1, nblvlm
    376373        ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
    377374      enddo
    … …  
    393390    ! on interpole sur les niveaux du gcm(niveau pression bien sur!)
    394391    !-----------------------------------------------------------------------
    395     do k = 1, klev
     392    DO k = 1, klev
    396393      IF (JM(k) == 0) THEN
    397394        !FKC bug? ne faut il pas convertir tsol en tendance ????
    … …  
    426423    tsaft = ts_subr
    427424    ! valeurs initiales des champs de convergence
    428     do k = 1, klev
     425    DO k = 1, klev
    429426      ht(k) = htaft(k)
    430427      hq(k) = hqaft(k)
    … …  
    473470    data alx, aly /100000., 150000./
    474471
    475     do k = 1, klev
     472    DO k = 1, klev
    476473      du = abs(vu_f(k) - cx) / alx
    477474      dv = abs(vv_f(k) - cy) / aly
    … …  
    489486    IMPLICIT NONE
    490487
    491     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    492     ! cette routine remplit les COMMON com1_phys_gcss et com2_phys_gcss.h
    493     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    494 
    495     INTEGER klev !nombre de niveau de pression du GCM
    496     REAL play(100)  !pression en Pa au milieu de chaque couche GCM
    497     INTEGER JM(100)
    498     REAL coef1(100)   !coefficient d interpolation
    499     REAL coef2(100)   !coefficient d interpolation
    500 
    501     INTEGER nblvlm !nombre de niveau de pression du mesoNH
    502     REAL playm(100) !pression en Pa au milieu de chaque couche Meso-NH
    503     REAL hplaym(100)!pression en hecto-Pa des milieux de couche Meso-NH
    504 
    505     COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
    506     COMMON/com2_phys_gcss/playm, hplaym, nblvlm
    507 
    508488    INTEGER k, klevgcm
    509489    REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
    … …  
    518498    !---------------------------------------------------------------------
    519499
    520     do k = 1, klev
     500    DO k = 1, klev
    521501      play(k) = playgcm(k)
    522502      PRINT*, 'la pression gcm est:', play(k)
    … …  
    526506    ! lecture du descripteur des donnees Meso-NH (forcing.ctl):
    527507    !  -> nb niveaux du meso.NH (nblvlm) + pressions meso.NH
    528     ! (on remplit le COMMON com2_phys_gcss)
    529508    !----------------------------------------------------------------------
    530509
    … …  
    536515    ! etude de la correspondance entre les niveaux meso.NH et GCM;
    537516    ! calcul des coefficients d interpolation coef1 et coef2
    538     ! (on remplit le COMMON com1_phys_gcss)
    539517    !----------------------------------------------------------------------
    540518
    … …  
    549527    WRITE(*, *) '--------------------------------------'
    550528    WRITE(*, *) 'GCM: nb niveaux:', klev, ' et pression, coeffs:'
    551     do k = 1, klev
     529    DO k = 1, klev
    552530      WRITE(*, *) play(k), coef1(k), coef2(k)
    553531    enddo
    554532    WRITE(*, *) 'MESO-NH: nb niveaux:', nblvlm, ' et pression:'
    555     do k = 1, nblvlm
     533    DO k = 1, nblvlm
    556534      WRITE(*, *) playm(k), hplaym(k)
    557535    enddo
    … …  
    570548    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    571549
    572     INTEGER nblvlm !nombre de niveau de pression du mesoNH
    573     REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
    574     REAL hplaym(100) !pression en hPa des milieux de couche Meso-NH
    575     COMMON/com2_phys_gcss/playm, hplaym, nblvlm
    576 
    577550    INTEGER i, lu, mlz, mlzh
    578551
    … …  
    586559    open(lu, file = file_forctl, form = 'formatted')
    587560
    588     do i = 1, 1000
     561    DO i = 1, 1000
    589562      read(lu, 1000, end = 999) a
    590563      IF (a == 'ZDEF') go to 100
    … …  
    608581    !      Si la pression est en HPa, la multiplier par 100
    609582    IF (playm(1) < 10000.) THEN
    610       do mlz = 1, nblvlm
     583      DO mlz = 1, nblvlm
    611584        playm(mlz) = playm(mlz) * 100.
    612585      enddo
    … …  
    617590
    618591    PRINT*, ' '
    619     do mlzh = 1, nblvlm
     592    DO mlzh = 1, nblvlm
    620593      hplaym(mlzh) = playm(mlzh) / 100.
    621594    enddo
    … …  
    644617    icomp = icount
    645618
    646     do k = 1, nl
     619    DO k = 1, nl
    647620      icomp = icomp + 1
    648621      read(itape, rec = icomp)z(k)
    649622      print *, 'icomp,k,z(k) ', icomp, k, z(k)
    650623    enddo
    651     do k = 1, nl
     624    DO k = 1, nl
    652625      icomp = icomp + 1
    653626      read(itape, rec = icomp)hT(k)
    654627      PRINT*, hT(k), k
    655628    enddo
    656     do k = 1, nl
     629    DO k = 1, nl
    657630      icomp = icomp + 1
    658631      read(itape, rec = icomp)hQ(k)
    … …  
    660633
    661634    IF(turb_fcg) THEN
    662       do k = 1, nl
     635      DO k = 1, nl
    663636        icomp = icomp + 1
    664637        read(itape, rec = icomp)hThTur(k)
    665638      enddo
    666       do k = 1, nl
     639      DO k = 1, nl
    667640        icomp = icomp + 1
    668641        read(itape, rec = icomp)hqTur(k)
    … …  
    672645
    673646    IF(imp_fcg) THEN
    674       do k = 1, nl
     647      DO k = 1, nl
    675648        icomp = icomp + 1
    676649        read(itape, rec = icomp)hu(k)
    677650      enddo
    678       do k = 1, nl
     651      DO k = 1, nl
    679652        icomp = icomp + 1
    680653        read(itape, rec = icomp)hv(k)
    … …  
    683656    endif
    684657
    685     do k = 1, nl
     658    DO k = 1, nl
    686659      icomp = icomp + 1
    687660      read(itape, rec = icomp)hw(k)
    … …  
    707680    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    708681
    709     INTEGER klev    !nombre de niveau de pression du GCM
    710     REAL play(100)  !pression en Pa au milieu de chaque couche GCM
    711     INTEGER JM(100)
    712     REAL coef1(100) !coefficient d interpolation
    713     REAL coef2(100) !coefficient d interpolation
    714 
    715     INTEGER nblvlm !nombre de niveau de pression du mesoNH
    716     REAL playm(100) !pression en Pa milieu de chaque couche Meso-NH
    717     REAL hplaym(100)!pression en hPa des milieux de couche Meso-NH
    718 
    719     COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
    720     COMMON/com2_phys_gcss/playm, hplaym, nblvlm
    721 
    722682    REAL psol
    723683    REAL val
    724684    INTEGER k, mlz
    725685
    726     do k = 1, klev
     686    DO k = 1, klev
    727687      val = play(k)
    728688      IF (val > playm(1)) THEN
    … …  
    732692        coef2(1) = (val - psol) / (playm(mlz + 1) - psol)
    733693      ELSE IF (val > playm(nblvlm)) THEN
    734         do mlz = 1, nblvlm
     694        DO mlz = 1, nblvlm
    735695          IF (val <= playm(mlz).AND. val > playm(mlz + 1))THEN
    736696            JM(k) = mlz

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90

    r5144 r5158  
    5757    USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
    5858    USE lmdz_yomcst
     59    USE lmdz_compar1d
     60    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     61
     62    IMPLICIT NONE
    5963
    6064    INCLUDE "dimensions.h"
    6165    INCLUDE "dimsoil.h"
    62     INCLUDE "compar1d.h"
    63     INCLUDE "date_cas.h"
    6466
    6567    !=====================================================================
    … …  
    454456    ! Initialization of the LOGICAL switch for nudging
    455457    jcode = iflag_nudge
    456     do i = 1, nudge_max
     458    DO i = 1, nudge_max
    457459      nudge(i) = mod(jcode, 10) >= 1
    458460      jcode = jcode / 10
    … …  
    696698      ! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
    697699      WRITE(*, *) '***********************'
    698       do l = 1, llm
     700      DO l = 1, llm
    699701        WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
    700702        IF (trouve_700 .AND. play(l)<=70000) THEN
    … …  
    10041006                PRINT*, temp(1), q(1, 1), u(1), v(1), plev(1), phis
    10051007        ! raz for safety
    1006         do l = 1, llm
     1008        DO l = 1, llm
    10071009                dq_dyn(l, 1) = 0.
    10081010        enddo
    … …  
    10491051
    10501052        phi(1) = RD * temp(1) * (plev(1) - play(1)) / (.5 * (plev(1) + play(1)))
    1051                 do l = 1, llm - 1
     1053                DO l = 1, llm - 1
    10521054                phi(l + 1) = phi(l) + RD * (temp(l) + temp(l + 1)) * &
    10531055        (play(l) - play(l + 1)) / (play(l) + play(l + 1))
    … …  
    11511153
    11521154        !on calcule dt_cooling
    1153         do l = 1, llm
     1155        DO l = 1, llm
    11541156        IF (play(l)>=20000.) THEN
    11551157        dt_cooling(l) = -1.5 / 86400.
    … …  
    12191221        d_t_adv = 0.
    12201222        d_q_adv = 0.
    1221         do l = 2, llm - 1
     1223        DO l = 2, llm - 1
    12221224        IF (zlay(l)<=1100) THEN
    12231225        wwww = -0.00001 * zlay(l)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90

    r5144 r5158  
    5050    USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
    5151    USE lmdz_yomcst
     52    USE lmdz_compar1d
     53    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
    5254
    5355    INCLUDE "dimensions.h"
    5456    INCLUDE "dimsoil.h"
    55     INCLUDE "compar1d.h"
    56     INCLUDE "date_cas.h"
    5757
    5858    !=====================================================================
    … …  
    280280
    281281    jcode = iflag_nudge
    282     do i = 1, nudge_max
     282    DO i = 1, nudge_max
    283283      nudge(i) = mod(jcode, 10) >= 1
    284284      jcode = jcode / 10
    … …  
    459459      ! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
    460460      WRITE(*, *) '***********************'
    461       do l = 1, llm
     461      DO l = 1, llm
    462462        WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
    463463        IF (trouve_700 .AND. play(l)<=70000) THEN
    … …  
    717717        !        phy_fter,phy_foce,phy_flic,phy_fsic)
    718718                !------------------------------------------------------------------------
    719                 do i = 1, year_len
     719                DO i = 1, year_len
    720720                phy_nat(i)  = nat_surf
    721721                phy_alb(i)  = albedo
    … …  
    759759                PRINT*, temp(1), q(1, 1), u(1), v(1), plev(1), phis(1)
    760760                ! raz for safety
    761                 do l = 1, llm
     761                DO l = 1, llm
    762762                d_q_vert_adv(l, 1) = 0.
    763763                enddo
    … …  
    780780
    781781        it_end = nint(fnday*day_step)
    782                 do while(it<=it_end)
     782                DO while(it<=it_end)
    783783
    784784                IF (prt_level>=1) THEN
    … …  
    804804        phi(1)= RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
    805805
    806                 do l = 1, llm-1
     806                DO l = 1, llm-1
    807807                phi(l+1)= phi(l)+RD*(temp(l)+temp(l+1))*                           &
    808808        (play(l)-play(l+1))/(play(l)+play(l+1))
    … …  
    824824
    825825        teta = temp*(pzero/play)**rkappa
    826         do l = 2, llm-1
     826        DO l = 2, llm-1
    827827        ! vertical tendencies computed as d X / d t = -W  d X / d z
    828828        d_u_vert_adv(l)= -w_adv(l)*(u(l+1)-u(l-1))/(z_adv(l+1)-z_adv(l-1))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90

    r5135 r5158  
    11MODULE mod_1D_amma_read
    2         USE netcdf, ONLY: nf90_get_var,nf90_open,nf90_noerr,nf90_open,nf90_nowrite,&
    3                 nf90_inq_dimid,nf90_inquire_dimension,nf90_strerror,nf90_inq_varid
    4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5 !Declarations specifiques au cas AMMA
    6         CHARACTER*80 :: fich_amma
    7 ! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
    8         INTEGER nlev_amma, nt_amma
    9 
    10         INTEGER year_ini_amma, day_ini_amma, mth_ini_amma
    11         REAL heure_ini_amma
    12         REAL day_ju_ini_amma   ! Julian day of amma first day
    13         parameter (year_ini_amma=2006)
    14         parameter (mth_ini_amma=7)
    15         parameter (day_ini_amma=10)  ! 10 = 10Juil2006
    16         parameter (heure_ini_amma=0.) !0h en secondes
    17         REAL dt_amma
    18         parameter (dt_amma=1800.)
    19 
    20 !profils initiaux:
    21         REAL, ALLOCATABLE:: plev_amma(:)
    22 
    23         REAL, ALLOCATABLE:: z_amma(:)
    24         REAL, ALLOCATABLE::  th_amma(:),q_amma(:)
    25         REAL, ALLOCATABLE:: u_amma(:)
    26         REAL, ALLOCATABLE:: v_amma(:)
    27 
    28         REAL, ALLOCATABLE::  th_ammai(:),q_ammai(:)
    29         REAL, ALLOCATABLE:: u_ammai(:)
    30         REAL, ALLOCATABLE:: v_ammai(:)
    31         REAL, ALLOCATABLE:: vitw_ammai(:)
    32         REAL, ALLOCATABLE:: ht_ammai(:)
    33         REAL, ALLOCATABLE:: hq_ammai(:)
    34         REAL, ALLOCATABLE:: vt_ammai(:)
    35         REAL, ALLOCATABLE:: vq_ammai(:)
    36 
    37 !forcings
    38         REAL, ALLOCATABLE::  ht_amma(:,:)
    39         REAL, ALLOCATABLE::  hq_amma(:,:)
    40         REAL, ALLOCATABLE::  vitw_amma(:,:)
    41         REAL, ALLOCATABLE::  lat_amma(:),sens_amma(:)
    42 
    43 !champs interpoles
    44         REAL, ALLOCATABLE:: vitw_profamma(:)
    45         REAL, ALLOCATABLE:: ht_profamma(:)
    46         REAL, ALLOCATABLE:: hq_profamma(:)
    47         REAL lat_profamma,sens_profamma
    48         REAL, ALLOCATABLE:: vt_profamma(:)
    49         REAL, ALLOCATABLE:: vq_profamma(:)
    50         REAL, ALLOCATABLE:: th_profamma(:)
    51         REAL, ALLOCATABLE:: q_profamma(:)
    52         REAL, ALLOCATABLE:: u_profamma(:)
    53         REAL, ALLOCATABLE:: v_profamma(:)
     2  USE netcdf, ONLY: nf90_get_var, nf90_open, nf90_noerr, nf90_open, nf90_nowrite, &
     3          nf90_inq_dimid, nf90_inquire_dimension, nf90_strerror, nf90_inq_varid
     4  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     5  !Declarations specifiques au cas AMMA
     6  CHARACTER*80 :: fich_amma
     7  ! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
     8  INTEGER nlev_amma, nt_amma
     9
     10  INTEGER year_ini_amma, day_ini_amma, mth_ini_amma
     11  REAL heure_ini_amma
     12  REAL day_ju_ini_amma   ! Julian day of amma first day
     13  parameter (year_ini_amma = 2006)
     14  parameter (mth_ini_amma = 7)
     15  parameter (day_ini_amma = 10)  ! 10 = 10Juil2006
     16  parameter (heure_ini_amma = 0.) !0h en secondes
     17  REAL dt_amma
     18  parameter (dt_amma = 1800.)
     19
     20  !profils initiaux:
     21  REAL, ALLOCATABLE :: plev_amma(:)
     22
     23  REAL, ALLOCATABLE :: z_amma(:)
     24  REAL, ALLOCATABLE :: th_amma(:), q_amma(:)
     25  REAL, ALLOCATABLE :: u_amma(:)
     26  REAL, ALLOCATABLE :: v_amma(:)
     27
     28  REAL, ALLOCATABLE :: th_ammai(:), q_ammai(:)
     29  REAL, ALLOCATABLE :: u_ammai(:)
     30  REAL, ALLOCATABLE :: v_ammai(:)
     31  REAL, ALLOCATABLE :: vitw_ammai(:)
     32  REAL, ALLOCATABLE :: ht_ammai(:)
     33  REAL, ALLOCATABLE :: hq_ammai(:)
     34  REAL, ALLOCATABLE :: vt_ammai(:)
     35  REAL, ALLOCATABLE :: vq_ammai(:)
     36
     37  !forcings
     38  REAL, ALLOCATABLE :: ht_amma(:, :)
     39  REAL, ALLOCATABLE :: hq_amma(:, :)
     40  REAL, ALLOCATABLE :: vitw_amma(:, :)
     41  REAL, ALLOCATABLE :: lat_amma(:), sens_amma(:)
     42
     43  !champs interpoles
     44  REAL, ALLOCATABLE :: vitw_profamma(:)
     45  REAL, ALLOCATABLE :: ht_profamma(:)
     46  REAL, ALLOCATABLE :: hq_profamma(:)
     47  REAL lat_profamma, sens_profamma
     48  REAL, ALLOCATABLE :: vt_profamma(:)
     49  REAL, ALLOCATABLE :: vq_profamma(:)
     50  REAL, ALLOCATABLE :: th_profamma(:)
     51  REAL, ALLOCATABLE :: q_profamma(:)
     52  REAL, ALLOCATABLE :: u_profamma(:)
     53  REAL, ALLOCATABLE :: v_profamma(:)
    5454
    5555
    5656CONTAINS
    5757
    58 SUBROUTINE read_1D_cases
    59       IMPLICIT NONE
    60 
    61       INTEGER nid,rid,ierr
    62 
    63       fich_amma='amma.nc'
    64       PRINT*,'fich_amma ',fich_amma
    65       ierr = nf90_open(fich_amma,nf90_nowrite,nid)
    66       PRINT*,'fich_amma,nf90_nowrite,nid ',fich_amma,nf90_nowrite,nid
    67       IF (ierr/=nf90_noerr) THEN
    68          WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    69          WRITE(*,*) nf90_strerror(ierr)
    70          stop ""
     58  SUBROUTINE read_1D_cases
     59    IMPLICIT NONE
     60
     61    INTEGER nid, rid, ierr
     62
     63    fich_amma = 'amma.nc'
     64    PRINT*, 'fich_amma ', fich_amma
     65    ierr = nf90_open(fich_amma, nf90_nowrite, nid)
     66    PRINT*, 'fich_amma,nf90_nowrite,nid ', fich_amma, nf90_nowrite, nid
     67    IF (ierr/=nf90_noerr) THEN
     68      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
     69      WRITE(*, *) nf90_strerror(ierr)
     70      stop ""
     71    endif
     72    !.......................................................................
     73    ierr = nf90_inq_dimid(nid, 'lev', rid)
     74    IF (ierr/=nf90_noerr) THEN
     75      PRINT*, 'Oh probleme lecture dimension zz'
     76    ENDIF
     77    ierr = nf90_inquire_dimension(nid, rid, len = nlev_amma)
     78    PRINT*, 'OK nid,rid,nlev_amma', nid, rid, nlev_amma
     79    !.......................................................................
     80    ierr = nf90_inq_dimid(nid, 'time', rid)
     81    PRINT*, 'nid,rid', nid, rid
     82    nt_amma = 0
     83    IF (ierr/=nf90_noerr) THEN
     84      stop 'probleme lecture dimension sens'
     85    ENDIF
     86    ierr = nf90_inquire_dimension(nid, rid, len = nt_amma)
     87    PRINT*, 'nid,rid,nlev_amma', nid, rid, nt_amma
     88
     89    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     90    !profils initiaux:
     91    allocate(plev_amma(nlev_amma))
     92
     93    allocate(z_amma(nlev_amma))
     94    allocate(th_amma(nlev_amma), q_amma(nlev_amma))
     95    allocate(u_amma(nlev_amma))
     96    allocate(v_amma(nlev_amma))
     97
     98    !forcings
     99    allocate(ht_amma(nlev_amma, nt_amma))
     100    allocate(hq_amma(nlev_amma, nt_amma))
     101    allocate(vitw_amma(nlev_amma, nt_amma))
     102    allocate(lat_amma(nt_amma), sens_amma(nt_amma))
     103
     104    !profils initiaux:
     105    allocate(th_ammai(nlev_amma), q_ammai(nlev_amma))
     106    allocate(u_ammai(nlev_amma))
     107    allocate(v_ammai(nlev_amma))
     108    allocate(vitw_ammai(nlev_amma))
     109    allocate(ht_ammai(nlev_amma))
     110    allocate(hq_ammai(nlev_amma))
     111    allocate(vt_ammai(nlev_amma))
     112    allocate(vq_ammai(nlev_amma))
     113
     114    !champs interpoles
     115    allocate(vitw_profamma(nlev_amma))
     116    allocate(ht_profamma(nlev_amma))
     117    allocate(hq_profamma(nlev_amma))
     118    allocate(vt_profamma(nlev_amma))
     119    allocate(vq_profamma(nlev_amma))
     120    allocate(th_profamma(nlev_amma))
     121    allocate(q_profamma(nlev_amma))
     122    allocate(u_profamma(nlev_amma))
     123    allocate(v_profamma(nlev_amma))
     124
     125    PRINT*, 'Allocations OK'
     126    CALL read_amma(nid, nlev_amma, nt_amma                                  &
     127            , z_amma, plev_amma, th_amma, q_amma, u_amma, v_amma, vitw_amma         &
     128            , ht_amma, hq_amma, sens_amma, lat_amma)
     129
     130  END SUBROUTINE read_1D_cases
     131
     132
     133  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     134  SUBROUTINE deallocate_1D_cases
     135    !profils initiaux:
     136    deallocate(plev_amma)
     137
     138    deallocate(z_amma)
     139    deallocate(th_amma, q_amma)
     140    deallocate(u_amma)
     141    deallocate(v_amma)
     142
     143    deallocate(th_ammai, q_ammai)
     144    deallocate(u_ammai)
     145    deallocate(v_ammai)
     146    deallocate(vitw_ammai)
     147    deallocate(ht_ammai)
     148    deallocate(hq_ammai)
     149    deallocate(vt_ammai)
     150    deallocate(vq_ammai)
     151
     152    !forcings
     153    deallocate(ht_amma)
     154    deallocate(hq_amma)
     155    deallocate(vitw_amma)
     156    deallocate(lat_amma, sens_amma)
     157
     158    !champs interpoles
     159    deallocate(vitw_profamma)
     160    deallocate(ht_profamma)
     161    deallocate(hq_profamma)
     162    deallocate(vt_profamma)
     163    deallocate(vq_profamma)
     164    deallocate(th_profamma)
     165    deallocate(q_profamma)
     166    deallocate(u_profamma)
     167    deallocate(v_profamma)
     168  END SUBROUTINE deallocate_1D_cases
     169
     170
     171  !=====================================================================
     172  SUBROUTINE read_amma(nid, nlevel, ntime                          &
     173          , zz, pp, temp, qv, u, v, dw                   &
     174          , dt, dq, sens, flat)
     175
     176    !program reading forcings of the AMMA case study
     177    IMPLICIT NONE
     178
     179    INTEGER ntime, nlevel
     180
     181    REAL zz(nlevel)
     182    REAL temp(nlevel), pp(nlevel)
     183    REAL qv(nlevel), u(nlevel)
     184    REAL v(nlevel)
     185    REAL dw(nlevel, ntime)
     186    REAL dt(nlevel, ntime)
     187    REAL dq(nlevel, ntime)
     188    REAL flat(ntime), sens(ntime)
     189
     190    INTEGER nid, ierr, rid
     191    INTEGER nbvar3d
     192    parameter(nbvar3d = 30)
     193    INTEGER var3didin(nbvar3d)
     194
     195    ierr = nf90_inq_varid(nid, "zz", var3didin(1))
     196    IF(ierr/=nf90_noerr) THEN
     197      WRITE(*, *) nf90_strerror(ierr)
     198      stop 'lev'
     199    endif
     200
     201    ierr = nf90_inq_varid(nid, "temp", var3didin(2))
     202    IF(ierr/=nf90_noerr) THEN
     203      WRITE(*, *) nf90_strerror(ierr)
     204      stop 'temp'
     205    endif
     206
     207    ierr = nf90_inq_varid(nid, "qv", var3didin(3))
     208    IF(ierr/=nf90_noerr) THEN
     209      WRITE(*, *) nf90_strerror(ierr)
     210      stop 'qv'
     211    endif
     212
     213    ierr = nf90_inq_varid(nid, "u", var3didin(4))
     214    IF(ierr/=nf90_noerr) THEN
     215      WRITE(*, *) nf90_strerror(ierr)
     216      stop 'u'
     217    endif
     218
     219    ierr = nf90_inq_varid(nid, "v", var3didin(5))
     220    IF(ierr/=nf90_noerr) THEN
     221      WRITE(*, *) nf90_strerror(ierr)
     222      stop 'v'
     223    endif
     224
     225    ierr = nf90_inq_varid(nid, "dw", var3didin(6))
     226    IF(ierr/=nf90_noerr) THEN
     227      WRITE(*, *) nf90_strerror(ierr)
     228      stop 'dw'
     229    endif
     230
     231    ierr = nf90_inq_varid(nid, "dt", var3didin(7))
     232    IF(ierr/=nf90_noerr) THEN
     233      WRITE(*, *) nf90_strerror(ierr)
     234      stop 'dt'
     235    endif
     236
     237    ierr = nf90_inq_varid(nid, "dq", var3didin(8))
     238    IF(ierr/=nf90_noerr) THEN
     239      WRITE(*, *) nf90_strerror(ierr)
     240      stop 'dq'
     241    endif
     242
     243    ierr = nf90_inq_varid(nid, "sens", var3didin(9))
     244    IF(ierr/=nf90_noerr) THEN
     245      WRITE(*, *) nf90_strerror(ierr)
     246      stop 'sens'
     247    endif
     248
     249    ierr = nf90_inq_varid(nid, "flat", var3didin(10))
     250    IF(ierr/=nf90_noerr) THEN
     251      WRITE(*, *) nf90_strerror(ierr)
     252      stop 'flat'
     253    endif
     254
     255    ierr = nf90_inq_varid(nid, "pp", var3didin(11))
     256    IF(ierr/=nf90_noerr) THEN
     257      WRITE(*, *) nf90_strerror(ierr)
     258    endif
     259
     260    !dimensions lecture
     261    !      CALL catchaxis(nid,ntime,nlevel,time,z,ierr)
     262
     263    ierr = nf90_get_var(nid, var3didin(1), zz)
     264    IF(ierr/=nf90_noerr) THEN
     265      WRITE(*, *) nf90_strerror(ierr)
     266      stop "getvarup"
     267    endif
     268    !          WRITE(*,*)'lecture z ok',zz
     269
     270    ierr = nf90_get_var(nid, var3didin(2), temp)
     271    IF(ierr/=nf90_noerr) THEN
     272      WRITE(*, *) nf90_strerror(ierr)
     273      stop "getvarup"
     274    endif
     275    !          WRITE(*,*)'lecture th ok',temp
     276
     277    ierr = nf90_get_var(nid, var3didin(3), qv)
     278    IF(ierr/=nf90_noerr) THEN
     279      WRITE(*, *) nf90_strerror(ierr)
     280      stop "getvarup"
     281    endif
     282    !          WRITE(*,*)'lecture qv ok',qv
     283
     284    ierr = nf90_get_var(nid, var3didin(4), u)
     285    IF(ierr/=nf90_noerr) THEN
     286      WRITE(*, *) nf90_strerror(ierr)
     287      stop "getvarup"
     288    endif
     289    !          WRITE(*,*)'lecture u ok',u
     290
     291    ierr = nf90_get_var(nid, var3didin(5), v)
     292    IF(ierr/=nf90_noerr) THEN
     293      WRITE(*, *) nf90_strerror(ierr)
     294      stop "getvarup"
     295    endif
     296    !          WRITE(*,*)'lecture v ok',v
     297
     298    ierr = nf90_get_var(nid, var3didin(6), dw)
     299    IF(ierr/=nf90_noerr) THEN
     300      WRITE(*, *) nf90_strerror(ierr)
     301      stop "getvarup"
     302    endif
     303    !          WRITE(*,*)'lecture w ok',dw
     304
     305    ierr = nf90_get_var(nid, var3didin(7), dt)
     306    IF(ierr/=nf90_noerr) THEN
     307      WRITE(*, *) nf90_strerror(ierr)
     308      stop "getvarup"
     309    endif
     310    !          WRITE(*,*)'lecture dt ok',dt
     311
     312    ierr = nf90_get_var(nid, var3didin(8), dq)
     313    IF(ierr/=nf90_noerr) THEN
     314      WRITE(*, *) nf90_strerror(ierr)
     315      stop "getvarup"
     316    endif
     317    !          WRITE(*,*)'lecture dq ok',dq
     318
     319    ierr = nf90_get_var(nid, var3didin(9), sens)
     320    IF(ierr/=nf90_noerr) THEN
     321      WRITE(*, *) nf90_strerror(ierr)
     322      stop "getvarup"
     323    endif
     324    !          WRITE(*,*)'lecture sens ok',sens
     325
     326    ierr = nf90_get_var(nid, var3didin(10), flat)
     327    IF(ierr/=nf90_noerr) THEN
     328      WRITE(*, *) nf90_strerror(ierr)
     329      stop "getvarup"
     330    endif
     331    !          WRITE(*,*)'lecture flat ok',flat
     332
     333    ierr = nf90_get_var(nid, var3didin(11), pp)
     334    IF(ierr/=nf90_noerr) THEN
     335      WRITE(*, *) nf90_strerror(ierr)
     336      stop "getvarup"
     337    endif
     338    !          WRITE(*,*)'lecture pp ok',pp
     339
     340  END SUBROUTINE  read_amma
     341  !======================================================================
     342  SUBROUTINE interp_amma_time(day, day1, annee_ref                     &
     343          , year_ini_amma, day_ini_amma, nt_amma, dt_amma, nlev_amma       &
     344          , vitw_amma, ht_amma, hq_amma, lat_amma, sens_amma               &
     345          , vitw_prof, ht_prof, hq_prof, lat_prof, sens_prof)
     346
     347    USE lmdz_compar1d
     348
     349    IMPLICIT NONE
     350
     351    !---------------------------------------------------------------------------------------
     352    ! Time interpolation of a 2D field to the timestep corresponding to day
     353
     354    ! day: current julian day (e.g. 717538.2)
     355    ! day1: first day of the simulation
     356    ! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
     357    ! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
     358    !---------------------------------------------------------------------------------------
     359
     360    ! inputs:
     361    INTEGER annee_ref
     362    INTEGER nt_amma, nlev_amma
     363    INTEGER year_ini_amma
     364    REAL day, day1, day_ini_amma, dt_amma
     365    REAL vitw_amma(nlev_amma, nt_amma)
     366    REAL ht_amma(nlev_amma, nt_amma)
     367    REAL hq_amma(nlev_amma, nt_amma)
     368    REAL lat_amma(nt_amma)
     369    REAL sens_amma(nt_amma)
     370    ! outputs:
     371    REAL vitw_prof(nlev_amma)
     372    REAL ht_prof(nlev_amma)
     373    REAL hq_prof(nlev_amma)
     374    REAL lat_prof, sens_prof
     375    ! local:
     376    INTEGER it_amma1, it_amma2, k
     377    REAL timeit, time_amma1, time_amma2, frac
     378
     379    IF (forcing_type==6) THEN
     380      ! Check that initial day of the simulation consistent with AMMA case:
     381      IF (annee_ref/=2006) THEN
     382        PRINT*, 'Pour AMMA, annee_ref doit etre 2006'
     383        PRINT*, 'Changer annee_ref dans run.def'
     384        stop
    71385      endif
    72 !.......................................................................
    73       ierr=nf90_inq_dimid(nid,'lev',rid)
    74       IF (ierr/=nf90_noerr) THEN
    75          PRINT*, 'Oh probleme lecture dimension zz'
    76       ENDIF
    77       ierr=nf90_inquire_dimension(nid,rid,len=nlev_amma)
    78       PRINT*,'OK nid,rid,nlev_amma',nid,rid,nlev_amma
    79 !.......................................................................
    80       ierr=nf90_inq_dimid(nid,'time',rid)
    81       PRINT*,'nid,rid',nid,rid
    82       nt_amma=0
    83       IF (ierr/=nf90_noerr) THEN
    84         stop 'probleme lecture dimension sens'
    85       ENDIF
    86       ierr=nf90_inquire_dimension(nid,rid,len=nt_amma)
    87       PRINT*,'nid,rid,nlev_amma',nid,rid,nt_amma
    88 
    89 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    90 !profils initiaux:
    91         allocate(plev_amma(nlev_amma))
    92        
    93         allocate(z_amma(nlev_amma))
    94         allocate(th_amma(nlev_amma),q_amma(nlev_amma))
    95         allocate(u_amma(nlev_amma))
    96         allocate(v_amma(nlev_amma))
    97 
    98 !forcings
    99         allocate(ht_amma(nlev_amma,nt_amma))
    100         allocate(hq_amma(nlev_amma,nt_amma))
    101         allocate(vitw_amma(nlev_amma,nt_amma))
    102         allocate(lat_amma(nt_amma),sens_amma(nt_amma))
    103 
    104 !profils initiaux:
    105         allocate(th_ammai(nlev_amma),q_ammai(nlev_amma))
    106         allocate(u_ammai(nlev_amma))
    107         allocate(v_ammai(nlev_amma))
    108         allocate(vitw_ammai(nlev_amma) )
    109         allocate(ht_ammai(nlev_amma))
    110         allocate(hq_ammai(nlev_amma))
    111         allocate(vt_ammai(nlev_amma))
    112         allocate(vq_ammai(nlev_amma))
    113 
    114 !champs interpoles
    115         allocate(vitw_profamma(nlev_amma))
    116         allocate(ht_profamma(nlev_amma))
    117         allocate(hq_profamma(nlev_amma))
    118         allocate(vt_profamma(nlev_amma))
    119         allocate(vq_profamma(nlev_amma))
    120         allocate(th_profamma(nlev_amma))
    121         allocate(q_profamma(nlev_amma))
    122         allocate(u_profamma(nlev_amma))
    123         allocate(v_profamma(nlev_amma))
    124 
    125         PRINT*,'Allocations OK'
    126         CALL read_amma(nid,nlev_amma,nt_amma                                  &
    127        ,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma         &
    128        ,ht_amma,hq_amma,sens_amma,lat_amma)
    129 
    130 END SUBROUTINE read_1D_cases
    131 
    132 
    133 
    134 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    135 SUBROUTINE deallocate_1D_cases
    136 !profils initiaux:
    137         deallocate(plev_amma)
    138        
    139         deallocate(z_amma)
    140         deallocate(th_amma,q_amma)
    141         deallocate(u_amma)
    142         deallocate(v_amma)
    143 
    144         deallocate(th_ammai,q_ammai)
    145         deallocate(u_ammai)
    146         deallocate(v_ammai)
    147         deallocate(vitw_ammai )
    148         deallocate(ht_ammai)
    149         deallocate(hq_ammai)
    150         deallocate(vt_ammai)
    151         deallocate(vq_ammai)
    152        
    153 !forcings
    154         deallocate(ht_amma)
    155         deallocate(hq_amma)
    156         deallocate(vitw_amma)
    157         deallocate(lat_amma,sens_amma)
    158 
    159 !champs interpoles
    160         deallocate(vitw_profamma)
    161         deallocate(ht_profamma)
    162         deallocate(hq_profamma)
    163         deallocate(vt_profamma)
    164         deallocate(vq_profamma)
    165         deallocate(th_profamma)
    166         deallocate(q_profamma)
    167         deallocate(u_profamma)
    168         deallocate(v_profamma)
    169 END SUBROUTINE deallocate_1D_cases
    170 
    171 
    172 !=====================================================================
    173       SUBROUTINE read_amma(nid,nlevel,ntime                          &
    174        ,zz,pp,temp,qv,u,v,dw                   &
    175        ,dt,dq,sens,flat)
    176 
    177 !program reading forcings of the AMMA case study
    178       IMPLICIT NONE
    179 
    180       INTEGER ntime,nlevel
    181 
    182       REAL zz(nlevel)
    183       REAL temp(nlevel),pp(nlevel)
    184       REAL qv(nlevel),u(nlevel)
    185       REAL v(nlevel)
    186       REAL dw(nlevel,ntime)
    187       REAL dt(nlevel,ntime)
    188       REAL dq(nlevel,ntime)
    189       REAL flat(ntime),sens(ntime)
    190 
    191 
    192       INTEGER nid, ierr,rid
    193       INTEGER nbvar3d
    194       parameter(nbvar3d=30)
    195       INTEGER var3didin(nbvar3d)
    196 
    197        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
    198          IF(ierr/=nf90_noerr) THEN
    199            WRITE(*,*) nf90_strerror(ierr)
    200            stop 'lev'
    201          endif
    202 
    203 
    204       ierr=nf90_inq_varid(nid,"temp",var3didin(2))
    205          IF(ierr/=nf90_noerr) THEN
    206            WRITE(*,*) nf90_strerror(ierr)
    207            stop 'temp'
    208          endif
    209 
    210       ierr=nf90_inq_varid(nid,"qv",var3didin(3))
    211          IF(ierr/=nf90_noerr) THEN
    212            WRITE(*,*) nf90_strerror(ierr)
    213            stop 'qv'
    214          endif
    215 
    216       ierr=nf90_inq_varid(nid,"u",var3didin(4))
    217          IF(ierr/=nf90_noerr) THEN
    218            WRITE(*,*) nf90_strerror(ierr)
    219            stop 'u'
    220          endif
    221 
    222       ierr=nf90_inq_varid(nid,"v",var3didin(5))
    223          IF(ierr/=nf90_noerr) THEN
    224            WRITE(*,*) nf90_strerror(ierr)
    225            stop 'v'
    226          endif
    227 
    228       ierr=nf90_inq_varid(nid,"dw",var3didin(6))
    229          IF(ierr/=nf90_noerr) THEN
    230            WRITE(*,*) nf90_strerror(ierr)
    231            stop 'dw'
    232          endif
    233 
    234       ierr=nf90_inq_varid(nid,"dt",var3didin(7))
    235          IF(ierr/=nf90_noerr) THEN
    236            WRITE(*,*) nf90_strerror(ierr)
    237            stop 'dt'
    238          endif
    239 
    240       ierr=nf90_inq_varid(nid,"dq",var3didin(8))
    241          IF(ierr/=nf90_noerr) THEN
    242            WRITE(*,*) nf90_strerror(ierr)
    243            stop 'dq'
    244          endif
    245      
    246       ierr=nf90_inq_varid(nid,"sens",var3didin(9))
    247          IF(ierr/=nf90_noerr) THEN
    248            WRITE(*,*) nf90_strerror(ierr)
    249            stop 'sens'
    250          endif
    251 
    252       ierr=nf90_inq_varid(nid,"flat",var3didin(10))
    253          IF(ierr/=nf90_noerr) THEN
    254            WRITE(*,*) nf90_strerror(ierr)
    255            stop 'flat'
    256          endif
    257 
    258       ierr=nf90_inq_varid(nid,"pp",var3didin(11))
    259          IF(ierr/=nf90_noerr) THEN
    260            WRITE(*,*) nf90_strerror(ierr)
     386      IF (annee_ref==2006 .AND. day1<day_ini_amma) THEN
     387        PRINT*, 'AMMA a débuté le 10 juillet 2006', day1, day_ini_amma
     388        PRINT*, 'Changer dayref dans run.def'
     389        stop
    261390      endif
    262 
    263 !dimensions lecture
    264 !      CALL catchaxis(nid,ntime,nlevel,time,z,ierr)
    265  
    266          ierr = nf90_get_var(nid,var3didin(1),zz)
    267          IF(ierr/=nf90_noerr) THEN
    268             WRITE(*,*) nf90_strerror(ierr)
    269             stop "getvarup"
    270          endif
    271 !          WRITE(*,*)'lecture z ok',zz
    272 
    273          ierr = nf90_get_var(nid,var3didin(2),temp)
    274          IF(ierr/=nf90_noerr) THEN
    275             WRITE(*,*) nf90_strerror(ierr)
    276             stop "getvarup"
    277          endif
    278 !          WRITE(*,*)'lecture th ok',temp
    279 
    280          ierr = nf90_get_var(nid,var3didin(3),qv)
    281          IF(ierr/=nf90_noerr) THEN
    282             WRITE(*,*) nf90_strerror(ierr)
    283             stop "getvarup"
    284          endif
    285 !          WRITE(*,*)'lecture qv ok',qv
    286  
    287          ierr = nf90_get_var(nid,var3didin(4),u)
    288          IF(ierr/=nf90_noerr) THEN
    289             WRITE(*,*) nf90_strerror(ierr)
    290             stop "getvarup"
    291          endif
    292 !          WRITE(*,*)'lecture u ok',u
    293 
    294          ierr = nf90_get_var(nid,var3didin(5),v)
    295          IF(ierr/=nf90_noerr) THEN
    296             WRITE(*,*) nf90_strerror(ierr)
    297             stop "getvarup"
    298          endif
    299 !          WRITE(*,*)'lecture v ok',v
    300 
    301          ierr = nf90_get_var(nid,var3didin(6),dw)
    302          IF(ierr/=nf90_noerr) THEN
    303             WRITE(*,*) nf90_strerror(ierr)
    304             stop "getvarup"
    305          endif
    306 !          WRITE(*,*)'lecture w ok',dw
    307 
    308          ierr = nf90_get_var(nid,var3didin(7),dt)
    309          IF(ierr/=nf90_noerr) THEN
    310             WRITE(*,*) nf90_strerror(ierr)
    311             stop "getvarup"
    312          endif
    313 !          WRITE(*,*)'lecture dt ok',dt
    314 
    315          ierr = nf90_get_var(nid,var3didin(8),dq)
    316          IF(ierr/=nf90_noerr) THEN
    317             WRITE(*,*) nf90_strerror(ierr)
    318             stop "getvarup"
    319          endif
    320 !          WRITE(*,*)'lecture dq ok',dq
    321 
    322          ierr = nf90_get_var(nid,var3didin(9),sens)
    323          IF(ierr/=nf90_noerr) THEN
    324             WRITE(*,*) nf90_strerror(ierr)
    325             stop "getvarup"
    326          endif
    327 !          WRITE(*,*)'lecture sens ok',sens
    328 
    329          ierr = nf90_get_var(nid,var3didin(10),flat)
    330          IF(ierr/=nf90_noerr) THEN
    331             WRITE(*,*) nf90_strerror(ierr)
    332             stop "getvarup"
    333          endif
    334 !          WRITE(*,*)'lecture flat ok',flat
    335 
    336          ierr = nf90_get_var(nid,var3didin(11),pp)
    337          IF(ierr/=nf90_noerr) THEN
    338             WRITE(*,*) nf90_strerror(ierr)
    339             stop "getvarup"
    340          endif
    341 !          WRITE(*,*)'lecture pp ok',pp
    342 
    343 
    344          END SUBROUTINE  read_amma
    345 !======================================================================
    346         SUBROUTINE interp_amma_time(day,day1,annee_ref                     &
    347            ,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma       &
    348            ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma               &
    349            ,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof)
    350         IMPLICIT NONE
    351 
    352 !---------------------------------------------------------------------------------------
    353 ! Time interpolation of a 2D field to the timestep corresponding to day
    354 
    355 ! day: current julian day (e.g. 717538.2)
    356 ! day1: first day of the simulation
    357 ! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
    358 ! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
    359 !---------------------------------------------------------------------------------------
    360 
    361         INCLUDE "compar1d.h"
    362 
    363 ! inputs:
    364         INTEGER annee_ref
    365         INTEGER nt_amma,nlev_amma
    366         INTEGER year_ini_amma
    367         REAL day, day1,day_ini_amma,dt_amma
    368         REAL vitw_amma(nlev_amma,nt_amma)
    369         REAL ht_amma(nlev_amma,nt_amma)
    370         REAL hq_amma(nlev_amma,nt_amma)
    371         REAL lat_amma(nt_amma)
    372         REAL sens_amma(nt_amma)
    373 ! outputs:
    374         REAL vitw_prof(nlev_amma)
    375         REAL ht_prof(nlev_amma)
    376         REAL hq_prof(nlev_amma)
    377         REAL lat_prof,sens_prof
    378 ! local:
    379         INTEGER it_amma1, it_amma2,k
    380         REAL timeit,time_amma1,time_amma2,frac
    381 
    382 
    383         IF (forcing_type==6) THEN
    384 ! Check that initial day of the simulation consistent with AMMA case:
    385        IF (annee_ref/=2006) THEN
    386         PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    387         PRINT*,'Changer annee_ref dans run.def'
     391      IF (annee_ref==2006 .AND. day1>day_ini_amma + 1) THEN
     392        PRINT*, 'AMMA a fini le 11 juillet'
     393        PRINT*, 'Changer dayref ou nday dans run.def'
    388394        stop
    389        endif
    390        IF (annee_ref==2006 .AND. day1<day_ini_amma) THEN
    391         PRINT*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
    392         PRINT*,'Changer dayref dans run.def'
    393         stop
    394        endif
    395        IF (annee_ref==2006 .AND. day1>day_ini_amma+1) THEN
    396         PRINT*,'AMMA a fini le 11 juillet'
    397         PRINT*,'Changer dayref ou nday dans run.def'
    398         stop
    399        endif
    400        endif
    401 
    402 ! Determine timestep relative to the 1st day of AMMA:
    403 !       timeit=(day-day1)*86400.
    404 !       if (annee_ref.EQ.1992) THEN
    405 !        timeit=(day-day_ini_toga)*86400.
    406 !       else
    407 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    408 !       endif
    409       timeit=(day-day_ini_amma)*86400
    410 
    411 ! Determine the closest observation times:
    412 !       it_amma1=INT(timeit/dt_amma)+1
    413 !       it_amma2=it_amma1 + 1
    414 !       time_amma1=(it_amma1-1)*dt_amma
    415 !       time_amma2=(it_amma2-1)*dt_amma
    416 
    417        it_amma1=INT(timeit/dt_amma)+1
    418        IF (it_amma1 == nt_amma) THEN
    419        it_amma2=it_amma1
    420        ELSE
    421        it_amma2=it_amma1 + 1
    422        ENDIF
    423        time_amma1=(it_amma1-1)*dt_amma
    424        time_amma2=(it_amma2-1)*dt_amma
    425 
    426        IF (it_amma1 > nt_amma) THEN
    427         WRITE(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
    428           ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
    429         stop
    430        endif
    431 
    432 ! time interpolation:
    433        IF (it_amma1 == it_amma2) THEN
    434           frac=0.
    435        ELSE
    436           frac=(time_amma2-timeit)/(time_amma2-time_amma1)
    437           frac=max(frac,0.0)
    438        ENDIF
    439 
    440        lat_prof = lat_amma(it_amma2)                                       &
    441             -frac*(lat_amma(it_amma2)-lat_amma(it_amma1))
    442        sens_prof = sens_amma(it_amma2)                                     &
    443             -frac*(sens_amma(it_amma2)-sens_amma(it_amma1))
    444 
    445        do k=1,nlev_amma
    446         vitw_prof(k) = vitw_amma(k,it_amma2)                               &
    447             -frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1))
    448         ht_prof(k) = ht_amma(k,it_amma2)                                   &
    449             -frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1))
    450         hq_prof(k) = hq_amma(k,it_amma2)                                   &
    451             -frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1))
    452         enddo
    453 
    454         RETURN
    455         END
     395      endif
     396    endif
     397
     398    ! Determine timestep relative to the 1st day of AMMA:
     399    !       timeit=(day-day1)*86400.
     400    !       if (annee_ref.EQ.1992) THEN
     401    !        timeit=(day-day_ini_toga)*86400.
     402    !       else
     403    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     404    !       endif
     405    timeit = (day - day_ini_amma) * 86400
     406
     407    ! Determine the closest observation times:
     408    !       it_amma1=INT(timeit/dt_amma)+1
     409    !       it_amma2=it_amma1 + 1
     410    !       time_amma1=(it_amma1-1)*dt_amma
     411    !       time_amma2=(it_amma2-1)*dt_amma
     412
     413    it_amma1 = INT(timeit / dt_amma) + 1
     414    IF (it_amma1 == nt_amma) THEN
     415      it_amma2 = it_amma1
     416    ELSE
     417      it_amma2 = it_amma1 + 1
     418    ENDIF
     419    time_amma1 = (it_amma1 - 1) * dt_amma
     420    time_amma2 = (it_amma2 - 1) * dt_amma
     421
     422    IF (it_amma1 > nt_amma) THEN
     423      WRITE(*, *) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
     424              , day, day_ini_amma, it_amma1, it_amma2, timeit / 86400.
     425      stop
     426    endif
     427
     428    ! time interpolation:
     429    IF (it_amma1 == it_amma2) THEN
     430      frac = 0.
     431    ELSE
     432      frac = (time_amma2 - timeit) / (time_amma2 - time_amma1)
     433      frac = max(frac, 0.0)
     434    ENDIF
     435
     436    lat_prof = lat_amma(it_amma2)                                       &
     437            - frac * (lat_amma(it_amma2) - lat_amma(it_amma1))
     438    sens_prof = sens_amma(it_amma2)                                     &
     439            - frac * (sens_amma(it_amma2) - sens_amma(it_amma1))
     440
     441    DO k = 1, nlev_amma
     442      vitw_prof(k) = vitw_amma(k, it_amma2)                               &
     443              - frac * (vitw_amma(k, it_amma2) - vitw_amma(k, it_amma1))
     444      ht_prof(k) = ht_amma(k, it_amma2)                                   &
     445              - frac * (ht_amma(k, it_amma2) - ht_amma(k, it_amma1))
     446      hq_prof(k) = hq_amma(k, it_amma2)                                   &
     447              - frac * (hq_amma(k, it_amma2) - hq_amma(k, it_amma1))
     448    enddo
     449
     450    RETURN
     451  END
    456452
    457453END MODULE mod_1D_amma_read

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90

    r5135 r5158  
    11MODULE mod_1D_cases_read
    2   USE netcdf, ONLY: nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_inquire_dimension,nf90_inq_dimid,&
    3           nf90_nowrite,nf90_open,nf90_get_var
    4 
    5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    6 !Declarations specifiques au cas standard
    7         CHARACTER*80 :: fich_cas
    8 ! Discr?tisation
    9         INTEGER nlev_cas, nt_cas
    10 
    11 
    12 !       integer year_ini_cas, day_ini_cas, mth_ini_cas
    13 !       real heure_ini_cas
    14 !       real day_ju_ini_cas   ! Julian day of case first day
    15 !       parameter (year_ini_cas=2011)
    16 !       parameter (year_ini_cas=1969)
    17 !       parameter (mth_ini_cas=10)
    18 !       parameter (mth_ini_cas=6)
    19 !       parameter (day_ini_cas=1)  ! 10 = 10Juil2006
    20 !       parameter (day_ini_cas=24)  ! 24 = 24 juin 1969
    21 !       parameter (heure_ini_cas=0.) !0h en secondes
    22 !       real pdt_cas
    23 !       parameter (pdt_cas=3.*3600)
    24 
    25 !CR ATTENTION TEST AMMA
    26 !        parameter (year_ini_cas=2006)
    27 !        parameter (mth_ini_cas=7)
    28 !        parameter (day_ini_cas=10)  ! 10 = 10Juil2006
    29 !        parameter (heure_ini_cas=0.) !0h en secondes
    30 !        parameter (pdt_cas=1800.)
    31 
    32 !profils environnementaux
    33         REAL, ALLOCATABLE::  plev_cas(:,:)
    34 
    35         REAL, ALLOCATABLE::  z_cas(:,:)
    36         REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),rh_cas(:,:)
    37         REAL, ALLOCATABLE::  th_cas(:,:),rv_cas(:,:)
    38         REAL, ALLOCATABLE::  u_cas(:,:)
    39         REAL, ALLOCATABLE::  v_cas(:,:)
    40 
    41 !forcing
    42         REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
    43         REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
    44         REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
    45         REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
    46         REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
    47         REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
    48         REAL, ALLOCATABLE::  vitw_cas(:,:)
    49         REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
    50         REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
    51         REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
    52 
    53 !champs interpoles
    54         REAL, ALLOCATABLE::  plev_prof_cas(:)
    55         REAL, ALLOCATABLE::  t_prof_cas(:)
    56         REAL, ALLOCATABLE::  q_prof_cas(:)
    57         REAL, ALLOCATABLE::  u_prof_cas(:)
    58         REAL, ALLOCATABLE::  v_prof_cas(:)
    59 
    60         REAL, ALLOCATABLE::  vitw_prof_cas(:)
    61         REAL, ALLOCATABLE::  ug_prof_cas(:)
    62         REAL, ALLOCATABLE::  vg_prof_cas(:)
    63         REAL, ALLOCATABLE::  ht_prof_cas(:)
    64         REAL, ALLOCATABLE::  hq_prof_cas(:)
    65         REAL, ALLOCATABLE::  vt_prof_cas(:)
    66         REAL, ALLOCATABLE::  vq_prof_cas(:)
    67         REAL, ALLOCATABLE::  dt_prof_cas(:)
    68         REAL, ALLOCATABLE::  dtrad_prof_cas(:)
    69         REAL, ALLOCATABLE::  dq_prof_cas(:)
    70         REAL, ALLOCATABLE::  hu_prof_cas(:)
    71         REAL, ALLOCATABLE::  hv_prof_cas(:)
    72         REAL, ALLOCATABLE::  vu_prof_cas(:)
    73         REAL, ALLOCATABLE::  vv_prof_cas(:)
    74         REAL, ALLOCATABLE::  du_prof_cas(:)
    75         REAL, ALLOCATABLE::  dv_prof_cas(:)
    76         REAL, ALLOCATABLE::  uw_prof_cas(:)
    77         REAL, ALLOCATABLE::  vw_prof_cas(:)
    78         REAL, ALLOCATABLE::  q1_prof_cas(:)
    79         REAL, ALLOCATABLE::  q2_prof_cas(:)
    80 
    81 
    82         REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    83 
     2  USE netcdf, ONLY: nf90_noerr, nf90_strerror, nf90_inq_varid, nf90_inquire_dimension, nf90_inq_dimid, &
     3          nf90_nowrite, nf90_open, nf90_get_var
     4
     5  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     6  !Declarations specifiques au cas standard
     7  CHARACTER*80 :: fich_cas
     8  ! Discr?tisation
     9  INTEGER nlev_cas, nt_cas
     10
     11
     12  !       integer year_ini_cas, day_ini_cas, mth_ini_cas
     13  !       real heure_ini_cas
     14  !       real day_ju_ini_cas   ! Julian day of case first day
     15  !       parameter (year_ini_cas=2011)
     16  !       parameter (year_ini_cas=1969)
     17  !       parameter (mth_ini_cas=10)
     18  !       parameter (mth_ini_cas=6)
     19  !       parameter (day_ini_cas=1)  ! 10 = 10Juil2006
     20  !       parameter (day_ini_cas=24)  ! 24 = 24 juin 1969
     21  !       parameter (heure_ini_cas=0.) !0h en secondes
     22  !       real pdt_cas
     23  !       parameter (pdt_cas=3.*3600)
     24
     25  !CR ATTENTION TEST AMMA
     26  !        parameter (year_ini_cas=2006)
     27  !        parameter (mth_ini_cas=7)
     28  !        parameter (day_ini_cas=10)  ! 10 = 10Juil2006
     29  !        parameter (heure_ini_cas=0.) !0h en secondes
     30  !        parameter (pdt_cas=1800.)
     31
     32  !profils environnementaux
     33  REAL, ALLOCATABLE :: plev_cas(:, :)
     34
     35  REAL, ALLOCATABLE :: z_cas(:, :)
     36  REAL, ALLOCATABLE :: t_cas(:, :), q_cas(:, :), rh_cas(:, :)
     37  REAL, ALLOCATABLE :: th_cas(:, :), rv_cas(:, :)
     38  REAL, ALLOCATABLE :: u_cas(:, :)
     39  REAL, ALLOCATABLE :: v_cas(:, :)
     40
     41  !forcing
     42  REAL, ALLOCATABLE :: ht_cas(:, :), vt_cas(:, :), dt_cas(:, :), dtrad_cas(:, :)
     43  REAL, ALLOCATABLE :: hth_cas(:, :), vth_cas(:, :), dth_cas(:, :)
     44  REAL, ALLOCATABLE :: hq_cas(:, :), vq_cas(:, :), dq_cas(:, :)
     45  REAL, ALLOCATABLE :: hr_cas(:, :), vr_cas(:, :), dr_cas(:, :)
     46  REAL, ALLOCATABLE :: hu_cas(:, :), vu_cas(:, :), du_cas(:, :)
     47  REAL, ALLOCATABLE :: hv_cas(:, :), vv_cas(:, :), dv_cas(:, :)
     48  REAL, ALLOCATABLE :: vitw_cas(:, :)
     49  REAL, ALLOCATABLE :: ug_cas(:, :), vg_cas(:, :)
     50  REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), ts_cas(:), ustar_cas(:)
     51  REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :)
     52
     53  !champs interpoles
     54  REAL, ALLOCATABLE :: plev_prof_cas(:)
     55  REAL, ALLOCATABLE :: t_prof_cas(:)
     56  REAL, ALLOCATABLE :: q_prof_cas(:)
     57  REAL, ALLOCATABLE :: u_prof_cas(:)
     58  REAL, ALLOCATABLE :: v_prof_cas(:)
     59
     60  REAL, ALLOCATABLE :: vitw_prof_cas(:)
     61  REAL, ALLOCATABLE :: ug_prof_cas(:)
     62  REAL, ALLOCATABLE :: vg_prof_cas(:)
     63  REAL, ALLOCATABLE :: ht_prof_cas(:)
     64  REAL, ALLOCATABLE :: hq_prof_cas(:)
     65  REAL, ALLOCATABLE :: vt_prof_cas(:)
     66  REAL, ALLOCATABLE :: vq_prof_cas(:)
     67  REAL, ALLOCATABLE :: dt_prof_cas(:)
     68  REAL, ALLOCATABLE :: dtrad_prof_cas(:)
     69  REAL, ALLOCATABLE :: dq_prof_cas(:)
     70  REAL, ALLOCATABLE :: hu_prof_cas(:)
     71  REAL, ALLOCATABLE :: hv_prof_cas(:)
     72  REAL, ALLOCATABLE :: vu_prof_cas(:)
     73  REAL, ALLOCATABLE :: vv_prof_cas(:)
     74  REAL, ALLOCATABLE :: du_prof_cas(:)
     75  REAL, ALLOCATABLE :: dv_prof_cas(:)
     76  REAL, ALLOCATABLE :: uw_prof_cas(:)
     77  REAL, ALLOCATABLE :: vw_prof_cas(:)
     78  REAL, ALLOCATABLE :: q1_prof_cas(:)
     79  REAL, ALLOCATABLE :: q2_prof_cas(:)
     80
     81  REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas
    8482
    8583
    8684CONTAINS
    8785
    88 SUBROUTINE read_1D_cas
    89 
    90       INTEGER nid,rid,ierr
    91       INTEGER ii,jj
    92 
    93       fich_cas='setup/cas.nc'
    94       PRINT*,'fich_cas ',fich_cas
    95       ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    96       PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
    97       IF (ierr/=nf90_noerr) THEN
    98          WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    99          WRITE(*,*) nf90_strerror(ierr)
    100          stop ""
    101       endif
    102 !.......................................................................
    103       ierr=nf90_inq_dimid(nid,'lat',rid)
    104       IF (ierr/=nf90_noerr) THEN
    105          PRINT*, 'Oh probleme lecture dimension lat'
    106       ENDIF
    107       ierr=nf90_inquire_dimension(nid,rid,len=ii)
    108       PRINT*,'OK1 nid,rid,lat',nid,rid,ii
    109 !.......................................................................
    110       ierr=nf90_inq_dimid(nid,'lon',rid)
    111       IF (ierr/=nf90_noerr) THEN
    112          PRINT*, 'Oh probleme lecture dimension lon'
    113       ENDIF
    114       ierr=nf90_inquire_dimension(nid,rid,len=jj)
    115       PRINT*,'OK2 nid,rid,lat',nid,rid,jj
    116 !.......................................................................
    117       ierr=nf90_inq_dimid(nid,'lev',rid)
    118       IF (ierr/=nf90_noerr) THEN
    119          PRINT*, 'Oh probleme lecture dimension zz'
    120       ENDIF
    121       ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
    122       PRINT*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
    123 !.......................................................................
    124       ierr=nf90_inq_dimid(nid,'time',rid)
    125       PRINT*,'nid,rid',nid,rid
    126       nt_cas=0
    127       IF (ierr/=nf90_noerr) THEN
    128         stop 'probleme lecture dimension sens'
    129       ENDIF
    130       ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
    131       PRINT*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
    132 
    133 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    134 !profils moyens:
    135         allocate(plev_cas(nlev_cas,nt_cas))
    136         allocate(z_cas(nlev_cas,nt_cas))
    137         allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    138         allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
    139         allocate(u_cas(nlev_cas,nt_cas))
    140         allocate(v_cas(nlev_cas,nt_cas))
    141 
    142 !forcing
    143         allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
    144         allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    145         allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    146         allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    147         allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    148         allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    149         allocate(vitw_cas(nlev_cas,nt_cas))
    150         allocate(ug_cas(nlev_cas,nt_cas))
    151         allocate(vg_cas(nlev_cas,nt_cas))
    152         allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas))
    153         allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
    154 
    155 
    156 !champs interpoles
    157         allocate(plev_prof_cas(nlev_cas))
    158         allocate(t_prof_cas(nlev_cas))
    159         allocate(q_prof_cas(nlev_cas))
    160         allocate(u_prof_cas(nlev_cas))
    161         allocate(v_prof_cas(nlev_cas))
    162 
    163         allocate(vitw_prof_cas(nlev_cas))
    164         allocate(ug_prof_cas(nlev_cas))
    165         allocate(vg_prof_cas(nlev_cas))
    166         allocate(ht_prof_cas(nlev_cas))
    167         allocate(hq_prof_cas(nlev_cas))
    168         allocate(hu_prof_cas(nlev_cas))
    169         allocate(hv_prof_cas(nlev_cas))
    170         allocate(vt_prof_cas(nlev_cas))
    171         allocate(vq_prof_cas(nlev_cas))
    172         allocate(vu_prof_cas(nlev_cas))
    173         allocate(vv_prof_cas(nlev_cas))
    174         allocate(dt_prof_cas(nlev_cas))
    175         allocate(dtrad_prof_cas(nlev_cas))
    176         allocate(dq_prof_cas(nlev_cas))
    177         allocate(du_prof_cas(nlev_cas))
    178         allocate(dv_prof_cas(nlev_cas))
    179         allocate(uw_prof_cas(nlev_cas))
    180         allocate(vw_prof_cas(nlev_cas))
    181         allocate(q1_prof_cas(nlev_cas))
    182         allocate(q2_prof_cas(nlev_cas))
    183 
    184         PRINT*,'Allocations OK'
    185         CALL read_cas(nid,nlev_cas,nt_cas                                       &
    186        ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
    187        ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
    188        ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
    189        ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
    190        ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    191         PRINT*,'Read cas OK'
    192 
    193 
    194 END SUBROUTINE read_1D_cas
    195 
    196 
    197 
    198 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    199 SUBROUTINE deallocate_1D_cases
    200 !profils environnementaux:
    201         deallocate(plev_cas)
    202 
    203         deallocate(z_cas)
    204         deallocate(t_cas,q_cas,rh_cas)
    205         deallocate(th_cas,rv_cas)
    206         deallocate(u_cas)
    207         deallocate(v_cas)
    208 
    209 !forcing
    210         deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    211         deallocate(hq_cas,vq_cas,dq_cas)
    212         deallocate(hth_cas,vth_cas,dth_cas)
    213         deallocate(hr_cas,vr_cas,dr_cas)
    214         deallocate(hu_cas,vu_cas,du_cas)
    215         deallocate(hv_cas,vv_cas,dv_cas)
    216         deallocate(vitw_cas)
    217         deallocate(ug_cas)
    218         deallocate(vg_cas)
    219         deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    220 
    221 !champs interpoles
    222         deallocate(plev_prof_cas)
    223         deallocate(t_prof_cas)
    224         deallocate(q_prof_cas)
    225         deallocate(u_prof_cas)
    226         deallocate(v_prof_cas)
    227 
    228         deallocate(vitw_prof_cas)
    229         deallocate(ug_prof_cas)
    230         deallocate(vg_prof_cas)
    231         deallocate(ht_prof_cas)
    232         deallocate(hq_prof_cas)
    233         deallocate(hu_prof_cas)
    234         deallocate(hv_prof_cas)
    235         deallocate(vt_prof_cas)
    236         deallocate(vq_prof_cas)
    237         deallocate(vu_prof_cas)
    238         deallocate(vv_prof_cas)
    239         deallocate(dt_prof_cas)
    240         deallocate(dtrad_prof_cas)
    241         deallocate(dq_prof_cas)
    242         deallocate(du_prof_cas)
    243         deallocate(dv_prof_cas)
    244         deallocate(t_prof_cas)
    245         deallocate(q_prof_cas)
    246         deallocate(u_prof_cas)
    247         deallocate(v_prof_cas)
    248         deallocate(uw_prof_cas)
    249         deallocate(vw_prof_cas)
    250         deallocate(q1_prof_cas)
    251         deallocate(q2_prof_cas)
    252 
    253 END SUBROUTINE deallocate_1D_cases
     86  SUBROUTINE read_1D_cas
     87
     88    INTEGER nid, rid, ierr
     89    INTEGER ii, jj
     90
     91    fich_cas = 'setup/cas.nc'
     92    PRINT*, 'fich_cas ', fich_cas
     93    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
     94    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
     95    IF (ierr/=nf90_noerr) THEN
     96      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
     97      WRITE(*, *) nf90_strerror(ierr)
     98      stop ""
     99    endif
     100    !.......................................................................
     101    ierr = nf90_inq_dimid(nid, 'lat', rid)
     102    IF (ierr/=nf90_noerr) THEN
     103      PRINT*, 'Oh probleme lecture dimension lat'
     104    ENDIF
     105    ierr = nf90_inquire_dimension(nid, rid, len = ii)
     106    PRINT*, 'OK1 nid,rid,lat', nid, rid, ii
     107    !.......................................................................
     108    ierr = nf90_inq_dimid(nid, 'lon', rid)
     109    IF (ierr/=nf90_noerr) THEN
     110      PRINT*, 'Oh probleme lecture dimension lon'
     111    ENDIF
     112    ierr = nf90_inquire_dimension(nid, rid, len = jj)
     113    PRINT*, 'OK2 nid,rid,lat', nid, rid, jj
     114    !.......................................................................
     115    ierr = nf90_inq_dimid(nid, 'lev', rid)
     116    IF (ierr/=nf90_noerr) THEN
     117      PRINT*, 'Oh probleme lecture dimension zz'
     118    ENDIF
     119    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
     120    PRINT*, 'OK3 nid,rid,nlev_cas', nid, rid, nlev_cas
     121    !.......................................................................
     122    ierr = nf90_inq_dimid(nid, 'time', rid)
     123    PRINT*, 'nid,rid', nid, rid
     124    nt_cas = 0
     125    IF (ierr/=nf90_noerr) THEN
     126      stop 'probleme lecture dimension sens'
     127    ENDIF
     128    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
     129    PRINT*, 'OK4 nid,rid,nt_cas', nid, rid, nt_cas
     130
     131    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     132    !profils moyens:
     133    allocate(plev_cas(nlev_cas, nt_cas))
     134    allocate(z_cas(nlev_cas, nt_cas))
     135    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
     136    allocate(th_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
     137    allocate(u_cas(nlev_cas, nt_cas))
     138    allocate(v_cas(nlev_cas, nt_cas))
     139
     140    !forcing
     141    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
     142    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
     143    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
     144    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
     145    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
     146    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
     147    allocate(vitw_cas(nlev_cas, nt_cas))
     148    allocate(ug_cas(nlev_cas, nt_cas))
     149    allocate(vg_cas(nlev_cas, nt_cas))
     150    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ustar_cas(nt_cas))
     151    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
     152
     153
     154    !champs interpoles
     155    allocate(plev_prof_cas(nlev_cas))
     156    allocate(t_prof_cas(nlev_cas))
     157    allocate(q_prof_cas(nlev_cas))
     158    allocate(u_prof_cas(nlev_cas))
     159    allocate(v_prof_cas(nlev_cas))
     160
     161    allocate(vitw_prof_cas(nlev_cas))
     162    allocate(ug_prof_cas(nlev_cas))
     163    allocate(vg_prof_cas(nlev_cas))
     164    allocate(ht_prof_cas(nlev_cas))
     165    allocate(hq_prof_cas(nlev_cas))
     166    allocate(hu_prof_cas(nlev_cas))
     167    allocate(hv_prof_cas(nlev_cas))
     168    allocate(vt_prof_cas(nlev_cas))
     169    allocate(vq_prof_cas(nlev_cas))
     170    allocate(vu_prof_cas(nlev_cas))
     171    allocate(vv_prof_cas(nlev_cas))
     172    allocate(dt_prof_cas(nlev_cas))
     173    allocate(dtrad_prof_cas(nlev_cas))
     174    allocate(dq_prof_cas(nlev_cas))
     175    allocate(du_prof_cas(nlev_cas))
     176    allocate(dv_prof_cas(nlev_cas))
     177    allocate(uw_prof_cas(nlev_cas))
     178    allocate(vw_prof_cas(nlev_cas))
     179    allocate(q1_prof_cas(nlev_cas))
     180    allocate(q2_prof_cas(nlev_cas))
     181
     182    PRINT*, 'Allocations OK'
     183    CALL read_cas(nid, nlev_cas, nt_cas                                       &
     184            , z_cas, plev_cas, t_cas, q_cas, rh_cas, th_cas, rv_cas, u_cas, v_cas         &
     185            , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas, dv_cas, hv_cas, vv_cas    &
     186            , dt_cas, dtrad_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas                 &
     187            , dth_cas, hth_cas, vth_cas, dr_cas, hr_cas, vr_cas, sens_cas, lat_cas, ts_cas&
     188            , ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas)
     189    PRINT*, 'Read cas OK'
     190
     191  END SUBROUTINE read_1D_cas
     192
     193
     194  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     195  SUBROUTINE deallocate_1D_cases
     196    !profils environnementaux:
     197    deallocate(plev_cas)
     198
     199    deallocate(z_cas)
     200    deallocate(t_cas, q_cas, rh_cas)
     201    deallocate(th_cas, rv_cas)
     202    deallocate(u_cas)
     203    deallocate(v_cas)
     204
     205    !forcing
     206    deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas)
     207    deallocate(hq_cas, vq_cas, dq_cas)
     208    deallocate(hth_cas, vth_cas, dth_cas)
     209    deallocate(hr_cas, vr_cas, dr_cas)
     210    deallocate(hu_cas, vu_cas, du_cas)
     211    deallocate(hv_cas, vv_cas, dv_cas)
     212    deallocate(vitw_cas)
     213    deallocate(ug_cas)
     214    deallocate(vg_cas)
     215    deallocate(lat_cas, sens_cas, ts_cas, ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas)
     216
     217    !champs interpoles
     218    deallocate(plev_prof_cas)
     219    deallocate(t_prof_cas)
     220    deallocate(q_prof_cas)
     221    deallocate(u_prof_cas)
     222    deallocate(v_prof_cas)
     223
     224    deallocate(vitw_prof_cas)
     225    deallocate(ug_prof_cas)
     226    deallocate(vg_prof_cas)
     227    deallocate(ht_prof_cas)
     228    deallocate(hq_prof_cas)
     229    deallocate(hu_prof_cas)
     230    deallocate(hv_prof_cas)
     231    deallocate(vt_prof_cas)
     232    deallocate(vq_prof_cas)
     233    deallocate(vu_prof_cas)
     234    deallocate(vv_prof_cas)
     235    deallocate(dt_prof_cas)
     236    deallocate(dtrad_prof_cas)
     237    deallocate(dq_prof_cas)
     238    deallocate(du_prof_cas)
     239    deallocate(dv_prof_cas)
     240    deallocate(t_prof_cas)
     241    deallocate(q_prof_cas)
     242    deallocate(u_prof_cas)
     243    deallocate(v_prof_cas)
     244    deallocate(uw_prof_cas)
     245    deallocate(vw_prof_cas)
     246    deallocate(q1_prof_cas)
     247    deallocate(q2_prof_cas)
     248
     249  END SUBROUTINE deallocate_1D_cases
    254250
    255251  !=====================================================================
    256       SUBROUTINE read_cas(nid,nlevel,ntime                          &
    257        ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
    258        du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
    259        dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
    260 
    261 !program reading forcing of the case study
    262 
    263       INTEGER ntime,nlevel
    264 
    265       REAL zz(nlevel,ntime)
    266       REAL pp(nlevel,ntime)
    267       REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
    268       REAL theta(nlevel,ntime),rv(nlevel,ntime)
    269       REAL u(nlevel,ntime)
    270       REAL v(nlevel,ntime)
    271       REAL ug(nlevel,ntime)
    272       REAL vg(nlevel,ntime)
    273       REAL w(nlevel,ntime)
    274       REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    275       REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    276       REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    277       REAL dtrad(nlevel,ntime)
    278       REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    279       REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
    280       REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    281       REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
    282       REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    283 
    284 
    285       INTEGER nid, ierr,rid
    286       INTEGER nbvar3d
    287       parameter(nbvar3d=39)
    288       INTEGER var3didin(nbvar3d)
    289 
    290        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
    291          IF(ierr/=nf90_noerr) THEN
    292            WRITE(*,*) nf90_strerror(ierr)
    293            stop 'lev'
    294          endif
    295 
    296       ierr=nf90_inq_varid(nid,"pp",var3didin(2))
    297          IF(ierr/=nf90_noerr) THEN
    298            WRITE(*,*) nf90_strerror(ierr)
    299            stop 'plev'
    300          endif
    301 
    302 
    303       ierr=nf90_inq_varid(nid,"temp",var3didin(3))
    304          IF(ierr/=nf90_noerr) THEN
    305            WRITE(*,*) nf90_strerror(ierr)
    306            stop 'temp'
    307          endif
    308 
    309       ierr=nf90_inq_varid(nid,"qv",var3didin(4))
    310          IF(ierr/=nf90_noerr) THEN
    311            WRITE(*,*) nf90_strerror(ierr)
    312            stop 'qv'
    313          endif
    314 
    315       ierr=nf90_inq_varid(nid,"rh",var3didin(5))
    316          IF(ierr/=nf90_noerr) THEN
    317            WRITE(*,*) nf90_strerror(ierr)
    318            stop 'rh'
    319          endif
    320 
    321       ierr=nf90_inq_varid(nid,"theta",var3didin(6))
    322          IF(ierr/=nf90_noerr) THEN
    323            WRITE(*,*) nf90_strerror(ierr)
    324            stop 'theta'
    325          endif
    326 
    327       ierr=nf90_inq_varid(nid,"rv",var3didin(7))
    328          IF(ierr/=nf90_noerr) THEN
    329            WRITE(*,*) nf90_strerror(ierr)
    330            stop 'rv'
    331          endif
    332 
    333 
    334       ierr=nf90_inq_varid(nid,"u",var3didin(8))
    335          IF(ierr/=nf90_noerr) THEN
    336            WRITE(*,*) nf90_strerror(ierr)
    337            stop 'u'
    338          endif
    339 
    340       ierr=nf90_inq_varid(nid,"v",var3didin(9))
    341          IF(ierr/=nf90_noerr) THEN
    342            WRITE(*,*) nf90_strerror(ierr)
    343            stop 'v'
    344          endif
    345 
    346        ierr=nf90_inq_varid(nid,"ug",var3didin(10))
    347          IF(ierr/=nf90_noerr) THEN
    348            WRITE(*,*) nf90_strerror(ierr)
    349            stop 'ug'
    350          endif
    351 
    352       ierr=nf90_inq_varid(nid,"vg",var3didin(11))
    353          IF(ierr/=nf90_noerr) THEN
    354            WRITE(*,*) nf90_strerror(ierr)
    355            stop 'vg'
    356          endif
    357 
    358       ierr=nf90_inq_varid(nid,"w",var3didin(12))
    359          IF(ierr/=nf90_noerr) THEN
    360            WRITE(*,*) nf90_strerror(ierr)
    361            stop 'w'
    362          endif
    363 
    364       ierr=nf90_inq_varid(nid,"advu",var3didin(13))
    365          IF(ierr/=nf90_noerr) THEN
    366            WRITE(*,*) nf90_strerror(ierr)
    367            stop 'advu'
    368          endif
    369 
    370       ierr=nf90_inq_varid(nid,"hu",var3didin(14))
    371          IF(ierr/=nf90_noerr) THEN
    372            WRITE(*,*) nf90_strerror(ierr)
    373            stop 'hu'
    374          endif
    375 
    376        ierr=nf90_inq_varid(nid,"vu",var3didin(15))
    377          IF(ierr/=nf90_noerr) THEN
    378            WRITE(*,*) nf90_strerror(ierr)
    379            stop 'vu'
    380          endif
    381 
    382        ierr=nf90_inq_varid(nid,"advv",var3didin(16))
    383          IF(ierr/=nf90_noerr) THEN
    384            WRITE(*,*) nf90_strerror(ierr)
    385            stop 'advv'
    386          endif
    387 
    388       ierr=nf90_inq_varid(nid,"hv",var3didin(17))
    389          IF(ierr/=nf90_noerr) THEN
    390            WRITE(*,*) nf90_strerror(ierr)
    391            stop 'hv'
    392          endif
    393 
    394        ierr=nf90_inq_varid(nid,"vv",var3didin(18))
    395          IF(ierr/=nf90_noerr) THEN
    396            WRITE(*,*) nf90_strerror(ierr)
    397            stop 'vv'
    398          endif
    399 
    400       ierr=nf90_inq_varid(nid,"advT",var3didin(19))
    401          IF(ierr/=nf90_noerr) THEN
    402            WRITE(*,*) nf90_strerror(ierr)
    403            stop 'advT'
    404          endif
    405 
    406       ierr=nf90_inq_varid(nid,"hT",var3didin(20))
    407          IF(ierr/=nf90_noerr) THEN
    408            WRITE(*,*) nf90_strerror(ierr)
    409            stop 'hT'
    410          endif
    411 
    412       ierr=nf90_inq_varid(nid,"vT",var3didin(21))
    413          IF(ierr/=nf90_noerr) THEN
    414            WRITE(*,*) nf90_strerror(ierr)
    415            stop 'vT'
    416          endif
    417 
    418       ierr=nf90_inq_varid(nid,"advq",var3didin(22))
    419          IF(ierr/=nf90_noerr) THEN
    420            WRITE(*,*) nf90_strerror(ierr)
    421            stop 'advq'
    422          endif
    423 
    424       ierr=nf90_inq_varid(nid,"hq",var3didin(23))
    425          IF(ierr/=nf90_noerr) THEN
    426            WRITE(*,*) nf90_strerror(ierr)
    427            stop 'hq'
    428          endif
    429 
    430       ierr=nf90_inq_varid(nid,"vq",var3didin(24))
    431          IF(ierr/=nf90_noerr) THEN
    432            WRITE(*,*) nf90_strerror(ierr)
    433            stop 'vq'
    434          endif
    435 
    436       ierr=nf90_inq_varid(nid,"advth",var3didin(25))
    437          IF(ierr/=nf90_noerr) THEN
    438            WRITE(*,*) nf90_strerror(ierr)
    439            stop 'advth'
    440          endif
    441 
    442       ierr=nf90_inq_varid(nid,"hth",var3didin(26))
    443          IF(ierr/=nf90_noerr) THEN
    444            WRITE(*,*) nf90_strerror(ierr)
    445            stop 'hth'
    446          endif
    447 
    448       ierr=nf90_inq_varid(nid,"vth",var3didin(27))
    449          IF(ierr/=nf90_noerr) THEN
    450            WRITE(*,*) nf90_strerror(ierr)
    451            stop 'vth'
    452          endif
    453 
    454       ierr=nf90_inq_varid(nid,"advr",var3didin(28))
    455          IF(ierr/=nf90_noerr) THEN
    456            WRITE(*,*) nf90_strerror(ierr)
    457            stop 'advr'
    458          endif
    459 
    460       ierr=nf90_inq_varid(nid,"hr",var3didin(29))
    461          IF(ierr/=nf90_noerr) THEN
    462            WRITE(*,*) nf90_strerror(ierr)
    463            stop 'hr'
    464          endif
    465 
    466       ierr=nf90_inq_varid(nid,"vr",var3didin(30))
    467          IF(ierr/=nf90_noerr) THEN
    468            WRITE(*,*) nf90_strerror(ierr)
    469            stop 'vr'
    470          endif
    471 
    472       ierr=nf90_inq_varid(nid,"radT",var3didin(31))
    473          IF(ierr/=nf90_noerr) THEN
    474            WRITE(*,*) nf90_strerror(ierr)
    475            stop 'radT'
    476          endif
    477 
    478       ierr=nf90_inq_varid(nid,"sens",var3didin(32))
    479          IF(ierr/=nf90_noerr) THEN
    480            WRITE(*,*) nf90_strerror(ierr)
    481            stop 'sens'
    482          endif
    483 
    484       ierr=nf90_inq_varid(nid,"flat",var3didin(33))
    485          IF(ierr/=nf90_noerr) THEN
    486            WRITE(*,*) nf90_strerror(ierr)
    487            stop 'flat'
    488          endif
    489 
    490       ierr=nf90_inq_varid(nid,"ts",var3didin(34))
    491          IF(ierr/=nf90_noerr) THEN
    492            WRITE(*,*) nf90_strerror(ierr)
    493            stop 'ts'
    494          endif
    495 
    496       ierr=nf90_inq_varid(nid,"ustar",var3didin(35))
    497          IF(ierr/=nf90_noerr) THEN
    498            WRITE(*,*) nf90_strerror(ierr)
    499            stop 'ustar'
    500          endif
    501 
    502       ierr=nf90_inq_varid(nid,"uw",var3didin(36))
    503          IF(ierr/=nf90_noerr) THEN
    504            WRITE(*,*) nf90_strerror(ierr)
    505            stop 'uw'
    506          endif
    507 
    508       ierr=nf90_inq_varid(nid,"vw",var3didin(37))
    509          IF(ierr/=nf90_noerr) THEN
    510            WRITE(*,*) nf90_strerror(ierr)
    511            stop 'vw'
    512          endif
    513 
    514       ierr=nf90_inq_varid(nid,"q1",var3didin(38))
    515          IF(ierr/=nf90_noerr) THEN
    516            WRITE(*,*) nf90_strerror(ierr)
    517            stop 'q1'
    518          endif
    519 
    520       ierr=nf90_inq_varid(nid,"q2",var3didin(39))
    521          IF(ierr/=nf90_noerr) THEN
    522            WRITE(*,*) nf90_strerror(ierr)
    523            stop 'q2'
    524          endif
    525 
    526          ierr = nf90_get_var(nid,var3didin(1),zz)
    527          IF(ierr/=nf90_noerr) THEN
    528             WRITE(*,*) nf90_strerror(ierr)
    529             stop "getvarup"
    530          endif
    531 !          WRITE(*,*)'lecture z ok',zz
    532 
    533          ierr = nf90_get_var(nid,var3didin(2),pp)
    534          IF(ierr/=nf90_noerr) THEN
    535             WRITE(*,*) nf90_strerror(ierr)
    536             stop "getvarup"
    537          endif
    538 !          WRITE(*,*)'lecture pp ok',pp
    539 
    540 
    541          ierr = nf90_get_var(nid,var3didin(3),temp)
    542          IF(ierr/=nf90_noerr) THEN
    543             WRITE(*,*) nf90_strerror(ierr)
    544             stop "getvarup"
    545          endif
    546 !          WRITE(*,*)'lecture T ok',temp
    547 
    548          ierr = nf90_get_var(nid,var3didin(4),qv)
    549          IF(ierr/=nf90_noerr) THEN
    550             WRITE(*,*) nf90_strerror(ierr)
    551             stop "getvarup"
    552          endif
    553 !          WRITE(*,*)'lecture qv ok',qv
    554 
    555          ierr = nf90_get_var(nid,var3didin(5),rh)
    556          IF(ierr/=nf90_noerr) THEN
    557             WRITE(*,*) nf90_strerror(ierr)
    558             stop "getvarup"
    559          endif
    560 !          WRITE(*,*)'lecture rh ok',rh
    561 
    562          ierr = nf90_get_var(nid,var3didin(6),theta)
    563          IF(ierr/=nf90_noerr) THEN
    564             WRITE(*,*) nf90_strerror(ierr)
    565             stop "getvarup"
    566          endif
    567 !          WRITE(*,*)'lecture theta ok',theta
    568 
    569          ierr = nf90_get_var(nid,var3didin(7),rv)
    570          IF(ierr/=nf90_noerr) THEN
    571             WRITE(*,*) nf90_strerror(ierr)
    572             stop "getvarup"
    573          endif
    574 !          WRITE(*,*)'lecture rv ok',rv
    575 
    576          ierr = nf90_get_var(nid,var3didin(8),u)
    577          IF(ierr/=nf90_noerr) THEN
    578             WRITE(*,*) nf90_strerror(ierr)
    579             stop "getvarup"
    580          endif
    581 !          WRITE(*,*)'lecture u ok',u
    582 
    583          ierr = nf90_get_var(nid,var3didin(9),v)
    584          IF(ierr/=nf90_noerr) THEN
    585             WRITE(*,*) nf90_strerror(ierr)
    586             stop "getvarup"
    587          endif
    588 !          WRITE(*,*)'lecture v ok',v
    589 
    590          ierr = nf90_get_var(nid,var3didin(10),ug)
    591          IF(ierr/=nf90_noerr) THEN
    592             WRITE(*,*) nf90_strerror(ierr)
    593             stop "getvarup"
    594          endif
    595 !          WRITE(*,*)'lecture ug ok',ug
    596 
    597          ierr = nf90_get_var(nid,var3didin(11),vg)
    598          IF(ierr/=nf90_noerr) THEN
    599             WRITE(*,*) nf90_strerror(ierr)
    600             stop "getvarup"
    601          endif
    602 !          WRITE(*,*)'lecture vg ok',vg
    603 
    604          ierr = nf90_get_var(nid,var3didin(12),w)
    605          IF(ierr/=nf90_noerr) THEN
    606             WRITE(*,*) nf90_strerror(ierr)
    607             stop "getvarup"
    608          endif
    609 !          WRITE(*,*)'lecture w ok',w
    610 
    611          ierr = nf90_get_var(nid,var3didin(13),du)
    612          IF(ierr/=nf90_noerr) THEN
    613             WRITE(*,*) nf90_strerror(ierr)
    614             stop "getvarup"
    615          endif
    616 !          WRITE(*,*)'lecture du ok',du
    617 
    618          ierr = nf90_get_var(nid,var3didin(14),hu)
    619          IF(ierr/=nf90_noerr) THEN
    620             WRITE(*,*) nf90_strerror(ierr)
    621             stop "getvarup"
    622          endif
    623 !          WRITE(*,*)'lecture hu ok',hu
    624 
    625          ierr = nf90_get_var(nid,var3didin(15),vu)
    626          IF(ierr/=nf90_noerr) THEN
    627             WRITE(*,*) nf90_strerror(ierr)
    628             stop "getvarup"
    629          endif
    630 !          WRITE(*,*)'lecture vu ok',vu
    631 
    632          ierr = nf90_get_var(nid,var3didin(16),dv)
    633          IF(ierr/=nf90_noerr) THEN
    634             WRITE(*,*) nf90_strerror(ierr)
    635             stop "getvarup"
    636          endif
    637 !          WRITE(*,*)'lecture dv ok',dv
    638 
    639          ierr = nf90_get_var(nid,var3didin(17),hv)
    640          IF(ierr/=nf90_noerr) THEN
    641             WRITE(*,*) nf90_strerror(ierr)
    642             stop "getvarup"
    643          endif
    644 !          WRITE(*,*)'lecture hv ok',hv
    645 
    646          ierr = nf90_get_var(nid,var3didin(18),vv)
    647          IF(ierr/=nf90_noerr) THEN
    648             WRITE(*,*) nf90_strerror(ierr)
    649             stop "getvarup"
    650          endif
    651 !          WRITE(*,*)'lecture vv ok',vv
    652 
    653          ierr = nf90_get_var(nid,var3didin(19),dt)
    654          IF(ierr/=nf90_noerr) THEN
    655             WRITE(*,*) nf90_strerror(ierr)
    656             stop "getvarup"
    657          endif
    658 !          WRITE(*,*)'lecture dt ok',dt
    659 
    660          ierr = nf90_get_var(nid,var3didin(20),ht)
    661          IF(ierr/=nf90_noerr) THEN
    662             WRITE(*,*) nf90_strerror(ierr)
    663             stop "getvarup"
    664          endif
    665 !          WRITE(*,*)'lecture ht ok',ht
    666 
    667          ierr = nf90_get_var(nid,var3didin(21),vt)
    668          IF(ierr/=nf90_noerr) THEN
    669             WRITE(*,*) nf90_strerror(ierr)
    670             stop "getvarup"
    671          endif
    672 !          WRITE(*,*)'lecture vt ok',vt
    673 
    674          ierr = nf90_get_var(nid,var3didin(22),dq)
    675          IF(ierr/=nf90_noerr) THEN
    676             WRITE(*,*) nf90_strerror(ierr)
    677             stop "getvarup"
    678          endif
    679 !          WRITE(*,*)'lecture dq ok',dq
    680 
    681          ierr = nf90_get_var(nid,var3didin(23),hq)
    682          IF(ierr/=nf90_noerr) THEN
    683             WRITE(*,*) nf90_strerror(ierr)
    684             stop "getvarup"
    685          endif
    686 !          WRITE(*,*)'lecture hq ok',hq
    687 
    688          ierr = nf90_get_var(nid,var3didin(24),vq)
    689          IF(ierr/=nf90_noerr) THEN
    690             WRITE(*,*) nf90_strerror(ierr)
    691             stop "getvarup"
    692          endif
    693 !          WRITE(*,*)'lecture vq ok',vq
    694 
    695          ierr = nf90_get_var(nid,var3didin(25),dth)
    696          IF(ierr/=nf90_noerr) THEN
    697             WRITE(*,*) nf90_strerror(ierr)
    698             stop "getvarup"
    699          endif
    700 !          WRITE(*,*)'lecture dth ok',dth
    701 
    702          ierr = nf90_get_var(nid,var3didin(26),hth)
    703          IF(ierr/=nf90_noerr) THEN
    704             WRITE(*,*) nf90_strerror(ierr)
    705             stop "getvarup"
    706          endif
    707 !          WRITE(*,*)'lecture hth ok',hth
    708 
    709          ierr = nf90_get_var(nid,var3didin(27),vth)
    710          IF(ierr/=nf90_noerr) THEN
    711             WRITE(*,*) nf90_strerror(ierr)
    712             stop "getvarup"
    713          endif
    714 !          WRITE(*,*)'lecture vth ok',vth
    715 
    716          ierr = nf90_get_var(nid,var3didin(28),dr)
    717          IF(ierr/=nf90_noerr) THEN
    718             WRITE(*,*) nf90_strerror(ierr)
    719             stop "getvarup"
    720          endif
    721 !          WRITE(*,*)'lecture dr ok',dr
    722 
    723          ierr = nf90_get_var(nid,var3didin(29),hr)
    724          IF(ierr/=nf90_noerr) THEN
    725             WRITE(*,*) nf90_strerror(ierr)
    726             stop "getvarup"
    727          endif
    728 !          WRITE(*,*)'lecture hr ok',hr
    729 
    730          ierr = nf90_get_var(nid,var3didin(30),vr)
    731          IF(ierr/=nf90_noerr) THEN
    732             WRITE(*,*) nf90_strerror(ierr)
    733             stop "getvarup"
    734          endif
    735 !          WRITE(*,*)'lecture vr ok',vr
    736 
    737          ierr = nf90_get_var(nid,var3didin(31),dtrad)
    738          IF(ierr/=nf90_noerr) THEN
    739             WRITE(*,*) nf90_strerror(ierr)
    740             stop "getvarup"
    741          endif
    742 !          WRITE(*,*)'lecture dtrad ok',dtrad
    743 
    744          ierr = nf90_get_var(nid,var3didin(32),sens)
    745          IF(ierr/=nf90_noerr) THEN
    746             WRITE(*,*) nf90_strerror(ierr)
    747             stop "getvarup"
    748          endif
    749 !          WRITE(*,*)'lecture sens ok',sens
    750 
    751          ierr = nf90_get_var(nid,var3didin(33),flat)
    752          IF(ierr/=nf90_noerr) THEN
    753             WRITE(*,*) nf90_strerror(ierr)
    754             stop "getvarup"
    755          endif
    756 !          WRITE(*,*)'lecture flat ok',flat
    757 
    758          ierr = nf90_get_var(nid,var3didin(34),ts)
    759          IF(ierr/=nf90_noerr) THEN
    760             WRITE(*,*) nf90_strerror(ierr)
    761             stop "getvarup"
    762          endif
    763 !          WRITE(*,*)'lecture ts ok',ts
    764 
    765          ierr = nf90_get_var(nid,var3didin(35),ustar)
    766          IF(ierr/=nf90_noerr) THEN
    767             WRITE(*,*) nf90_strerror(ierr)
    768             stop "getvarup"
    769          endif
    770 !         WRITE(*,*)'lecture ustar ok',ustar
    771 
    772          ierr = nf90_get_var(nid,var3didin(36),uw)
    773          IF(ierr/=nf90_noerr) THEN
    774             WRITE(*,*) nf90_strerror(ierr)
    775             stop "getvarup"
    776          endif
    777 !         WRITE(*,*)'lecture uw ok',uw
    778 
    779          ierr = nf90_get_var(nid,var3didin(37),vw)
    780          IF(ierr/=nf90_noerr) THEN
    781             WRITE(*,*) nf90_strerror(ierr)
    782             stop "getvarup"
    783          endif
    784 !         WRITE(*,*)'lecture vw ok',vw
    785 
    786          ierr = nf90_get_var(nid,var3didin(38),q1)
    787          IF(ierr/=nf90_noerr) THEN
    788             WRITE(*,*) nf90_strerror(ierr)
    789             stop "getvarup"
    790          endif
    791 !         WRITE(*,*)'lecture q1 ok',q1
    792 
    793          ierr = nf90_get_var(nid,var3didin(39),q2)
    794          IF(ierr/=nf90_noerr) THEN
    795             WRITE(*,*) nf90_strerror(ierr)
    796             stop "getvarup"
    797          endif
    798 !         WRITE(*,*)'lecture q2 ok',q2
    799 
    800 
    801 
    802          END SUBROUTINE  read_cas
    803 !======================================================================
    804         SUBROUTINE interp_case_time(day,day1,annee_ref                &
    805 !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
    806            ,nt_cas,nlev_cas                                       &
    807            ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
    808            ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
    809            ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
    810            ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
    811            ,uw_cas,vw_cas,q1_cas,q2_cas                           &
    812            ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
    813            ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
    814            ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
    815            ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
    816            ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
    817            ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
    818            ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
    819 
    820 
    821         IMPLICIT NONE
    822 
    823 !---------------------------------------------------------------------------------------
    824 ! Time interpolation of a 2D field to the timestep corresponding to day
    825 
    826 ! day: current julian day (e.g. 717538.2)
    827 ! day1: first day of the simulation
    828 ! nt_cas: total nb of data in the forcing
    829 ! pdt_cas: total time interval (in sec) between 2 forcing data
    830 !---------------------------------------------------------------------------------------
    831 
    832         INCLUDE "compar1d.h"
    833         INCLUDE "date_cas.h"
    834 
    835 ! inputs:
    836         INTEGER annee_ref
    837         INTEGER nt_cas,nlev_cas
    838         REAL day, day1,day_cas
    839         REAL ts_cas(nt_cas)
    840         REAL plev_cas(nlev_cas,nt_cas)
    841         REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
    842         REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    843         REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    844         REAL vitw_cas(nlev_cas,nt_cas)
    845         REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    846         REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    847         REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    848         REAL dtrad_cas(nlev_cas,nt_cas)
    849         REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    850         REAL lat_cas(nt_cas)
    851         REAL sens_cas(nt_cas)
    852         REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    853         REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    854 
    855 ! outputs:
    856         REAL plev_prof_cas(nlev_cas)
    857         REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    858         REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    859         REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    860         REAL vitw_prof_cas(nlev_cas)
    861         REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    862         REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    863         REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    864         REAL dtrad_prof_cas(nlev_cas)
    865         REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    866         REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    867         REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    868 ! local:
    869         INTEGER it_cas1, it_cas2,k
    870         REAL timeit,time_cas1,time_cas2,frac
    871 
    872 
    873         PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    874 
    875 ! On teste si la date du cas AMMA est correcte.
    876 ! C est pour memoire car en fait les fichiers .def
    877 ! sont censes etre corrects.
    878 ! A supprimer a terme (MPL 20150623)
    879 !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    880 ! Check that initial day of the simulation consistent with AMMA case:
    881 !      if (annee_ref.NE.2006) THEN
    882 !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    883 !       PRINT*,'Changer annee_ref dans run.def'
    884 !       stop
    885 !      endif
    886 !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    887 !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    888 !       PRINT*,'Changer dayref dans run.def'
    889 !       stop
    890 !      endif
    891 !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    892 !       PRINT*,'AMMA a fini le 11 juillet'
    893 !       PRINT*,'Changer dayref ou nday dans run.def'
    894 !       stop
    895 !      endif
    896 !      endif
    897 
    898 ! Determine timestep relative to the 1st day:
    899 !       timeit=(day-day1)*86400.
    900 !       if (annee_ref.EQ.1992) THEN
    901 !        timeit=(day-day_cas)*86400.
    902 !       else
    903 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    904 !       endif
    905       timeit=(day-day_ju_ini_cas)*86400
    906       print *,'day=',day
    907       print *,'day_ju_ini_cas=',day_ju_ini_cas
    908       print *,'pdt_cas=',pdt_cas
    909       print *,'timeit=',timeit
    910       print *,'nt_cas=',nt_cas
    911 
    912 ! Determine the closest observation times:
    913 !       it_cas1=INT(timeit/pdt_cas)+1
    914 !       it_cas2=it_cas1 + 1
    915 !       time_cas1=(it_cas1-1)*pdt_cas
    916 !       time_cas2=(it_cas2-1)*pdt_cas
    917 
    918        it_cas1=INT(timeit/pdt_cas)+1
    919        IF (it_cas1 == nt_cas) THEN
    920        it_cas2=it_cas1
    921        ELSE
    922        it_cas2=it_cas1 + 1
    923        ENDIF
    924        time_cas1=(it_cas1-1)*pdt_cas
    925        time_cas2=(it_cas2-1)*pdt_cas
    926       print *,'it_cas1=',it_cas1
    927       print *,'it_cas2=',it_cas2
    928       print *,'time_cas1=',time_cas1
    929       print *,'time_cas2=',time_cas2
    930 
    931        IF (it_cas1 > nt_cas) THEN
    932         WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    933           ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    934         stop
    935        endif
    936 
    937 ! time interpolation:
    938        IF (it_cas1 == it_cas2) THEN
    939           frac=0.
    940        ELSE
    941           frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    942           frac=max(frac,0.0)
    943        ENDIF
    944 
    945        lat_prof_cas = lat_cas(it_cas2)                                       &
    946             -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    947        sens_prof_cas = sens_cas(it_cas2)                                     &
    948             -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    949        ts_prof_cas = ts_cas(it_cas2)                                         &
    950             -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    951        ustar_prof_cas = ustar_cas(it_cas2)                                   &
    952             -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    953 
    954        do k=1,nlev_cas
    955         plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
    956             -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    957         t_prof_cas(k) = t_cas(k,it_cas2)                               &
    958             -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    959         q_prof_cas(k) = q_cas(k,it_cas2)                               &
    960             -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
    961         u_prof_cas(k) = u_cas(k,it_cas2)                               &
    962             -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    963         v_prof_cas(k) = v_cas(k,it_cas2)                               &
    964             -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    965         ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    966             -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    967         vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    968             -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    969         vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
    970             -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    971         du_prof_cas(k) = du_cas(k,it_cas2)                                   &
    972             -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    973         hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
    974             -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    975         vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
    976             -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    977         dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
    978             -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    979         hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
    980             -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    981         vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
    982             -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    983         dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
    984             -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    985         ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
    986             -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    987         vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
    988             -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    989         dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
    990             -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    991         dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
    992             -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    993         hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
    994             -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    995         vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
    996             -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    997        uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
    998             -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    999        vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
    1000             -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1001        q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
    1002             -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1003        q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
    1004             -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1005         enddo
    1006 
    1007         RETURN
    1008         END
    1009 
    1010 !**********************************************************************************************
     252  SUBROUTINE read_cas(nid, nlevel, ntime                          &
     253          , zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, &
     254          du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, &
     255          dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2)
     256
     257    !program reading forcing of the case study
     258
     259    INTEGER ntime, nlevel
     260
     261    REAL zz(nlevel, ntime)
     262    REAL pp(nlevel, ntime)
     263    REAL temp(nlevel, ntime), qv(nlevel, ntime), rh(nlevel, ntime)
     264    REAL theta(nlevel, ntime), rv(nlevel, ntime)
     265    REAL u(nlevel, ntime)
     266    REAL v(nlevel, ntime)
     267    REAL ug(nlevel, ntime)
     268    REAL vg(nlevel, ntime)
     269    REAL w(nlevel, ntime)
     270    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
     271    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
     272    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
     273    REAL dtrad(nlevel, ntime)
     274    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
     275    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime)
     276    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
     277    REAL flat(ntime), sens(ntime), ts(ntime), ustar(ntime)
     278    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
     279
     280    INTEGER nid, ierr, rid
     281    INTEGER nbvar3d
     282    parameter(nbvar3d = 39)
     283    INTEGER var3didin(nbvar3d)
     284
     285    ierr = nf90_inq_varid(nid, "zz", var3didin(1))
     286    IF(ierr/=nf90_noerr) THEN
     287      WRITE(*, *) nf90_strerror(ierr)
     288      stop 'lev'
     289    endif
     290
     291    ierr = nf90_inq_varid(nid, "pp", var3didin(2))
     292    IF(ierr/=nf90_noerr) THEN
     293      WRITE(*, *) nf90_strerror(ierr)
     294      stop 'plev'
     295    endif
     296
     297    ierr = nf90_inq_varid(nid, "temp", var3didin(3))
     298    IF(ierr/=nf90_noerr) THEN
     299      WRITE(*, *) nf90_strerror(ierr)
     300      stop 'temp'
     301    endif
     302
     303    ierr = nf90_inq_varid(nid, "qv", var3didin(4))
     304    IF(ierr/=nf90_noerr) THEN
     305      WRITE(*, *) nf90_strerror(ierr)
     306      stop 'qv'
     307    endif
     308
     309    ierr = nf90_inq_varid(nid, "rh", var3didin(5))
     310    IF(ierr/=nf90_noerr) THEN
     311      WRITE(*, *) nf90_strerror(ierr)
     312      stop 'rh'
     313    endif
     314
     315    ierr = nf90_inq_varid(nid, "theta", var3didin(6))
     316    IF(ierr/=nf90_noerr) THEN
     317      WRITE(*, *) nf90_strerror(ierr)
     318      stop 'theta'
     319    endif
     320
     321    ierr = nf90_inq_varid(nid, "rv", var3didin(7))
     322    IF(ierr/=nf90_noerr) THEN
     323      WRITE(*, *) nf90_strerror(ierr)
     324      stop 'rv'
     325    endif
     326
     327    ierr = nf90_inq_varid(nid, "u", var3didin(8))
     328    IF(ierr/=nf90_noerr) THEN
     329      WRITE(*, *) nf90_strerror(ierr)
     330      stop 'u'
     331    endif
     332
     333    ierr = nf90_inq_varid(nid, "v", var3didin(9))
     334    IF(ierr/=nf90_noerr) THEN
     335      WRITE(*, *) nf90_strerror(ierr)
     336      stop 'v'
     337    endif
     338
     339    ierr = nf90_inq_varid(nid, "ug", var3didin(10))
     340    IF(ierr/=nf90_noerr) THEN
     341      WRITE(*, *) nf90_strerror(ierr)
     342      stop 'ug'
     343    endif
     344
     345    ierr = nf90_inq_varid(nid, "vg", var3didin(11))
     346    IF(ierr/=nf90_noerr) THEN
     347      WRITE(*, *) nf90_strerror(ierr)
     348      stop 'vg'
     349    endif
     350
     351    ierr = nf90_inq_varid(nid, "w", var3didin(12))
     352    IF(ierr/=nf90_noerr) THEN
     353      WRITE(*, *) nf90_strerror(ierr)
     354      stop 'w'
     355    endif
     356
     357    ierr = nf90_inq_varid(nid, "advu", var3didin(13))
     358    IF(ierr/=nf90_noerr) THEN
     359      WRITE(*, *) nf90_strerror(ierr)
     360      stop 'advu'
     361    endif
     362
     363    ierr = nf90_inq_varid(nid, "hu", var3didin(14))
     364    IF(ierr/=nf90_noerr) THEN
     365      WRITE(*, *) nf90_strerror(ierr)
     366      stop 'hu'
     367    endif
     368
     369    ierr = nf90_inq_varid(nid, "vu", var3didin(15))
     370    IF(ierr/=nf90_noerr) THEN
     371      WRITE(*, *) nf90_strerror(ierr)
     372      stop 'vu'
     373    endif
     374
     375    ierr = nf90_inq_varid(nid, "advv", var3didin(16))
     376    IF(ierr/=nf90_noerr) THEN
     377      WRITE(*, *) nf90_strerror(ierr)
     378      stop 'advv'
     379    endif
     380
     381    ierr = nf90_inq_varid(nid, "hv", var3didin(17))
     382    IF(ierr/=nf90_noerr) THEN
     383      WRITE(*, *) nf90_strerror(ierr)
     384      stop 'hv'
     385    endif
     386
     387    ierr = nf90_inq_varid(nid, "vv", var3didin(18))
     388    IF(ierr/=nf90_noerr) THEN
     389      WRITE(*, *) nf90_strerror(ierr)
     390      stop 'vv'
     391    endif
     392
     393    ierr = nf90_inq_varid(nid, "advT", var3didin(19))
     394    IF(ierr/=nf90_noerr) THEN
     395      WRITE(*, *) nf90_strerror(ierr)
     396      stop 'advT'
     397    endif
     398
     399    ierr = nf90_inq_varid(nid, "hT", var3didin(20))
     400    IF(ierr/=nf90_noerr) THEN
     401      WRITE(*, *) nf90_strerror(ierr)
     402      stop 'hT'
     403    endif
     404
     405    ierr = nf90_inq_varid(nid, "vT", var3didin(21))
     406    IF(ierr/=nf90_noerr) THEN
     407      WRITE(*, *) nf90_strerror(ierr)
     408      stop 'vT'
     409    endif
     410
     411    ierr = nf90_inq_varid(nid, "advq", var3didin(22))
     412    IF(ierr/=nf90_noerr) THEN
     413      WRITE(*, *) nf90_strerror(ierr)
     414      stop 'advq'
     415    endif
     416
     417    ierr = nf90_inq_varid(nid, "hq", var3didin(23))
     418    IF(ierr/=nf90_noerr) THEN
     419      WRITE(*, *) nf90_strerror(ierr)
     420      stop 'hq'
     421    endif
     422
     423    ierr = nf90_inq_varid(nid, "vq", var3didin(24))
     424    IF(ierr/=nf90_noerr) THEN
     425      WRITE(*, *) nf90_strerror(ierr)
     426      stop 'vq'
     427    endif
     428
     429    ierr = nf90_inq_varid(nid, "advth", var3didin(25))
     430    IF(ierr/=nf90_noerr) THEN
     431      WRITE(*, *) nf90_strerror(ierr)
     432      stop 'advth'
     433    endif
     434
     435    ierr = nf90_inq_varid(nid, "hth", var3didin(26))
     436    IF(ierr/=nf90_noerr) THEN
     437      WRITE(*, *) nf90_strerror(ierr)
     438      stop 'hth'
     439    endif
     440
     441    ierr = nf90_inq_varid(nid, "vth", var3didin(27))
     442    IF(ierr/=nf90_noerr) THEN
     443      WRITE(*, *) nf90_strerror(ierr)
     444      stop 'vth'
     445    endif
     446
     447    ierr = nf90_inq_varid(nid, "advr", var3didin(28))
     448    IF(ierr/=nf90_noerr) THEN
     449      WRITE(*, *) nf90_strerror(ierr)
     450      stop 'advr'
     451    endif
     452
     453    ierr = nf90_inq_varid(nid, "hr", var3didin(29))
     454    IF(ierr/=nf90_noerr) THEN
     455      WRITE(*, *) nf90_strerror(ierr)
     456      stop 'hr'
     457    endif
     458
     459    ierr = nf90_inq_varid(nid, "vr", var3didin(30))
     460    IF(ierr/=nf90_noerr) THEN
     461      WRITE(*, *) nf90_strerror(ierr)
     462      stop 'vr'
     463    endif
     464
     465    ierr = nf90_inq_varid(nid, "radT", var3didin(31))
     466    IF(ierr/=nf90_noerr) THEN
     467      WRITE(*, *) nf90_strerror(ierr)
     468      stop 'radT'
     469    endif
     470
     471    ierr = nf90_inq_varid(nid, "sens", var3didin(32))
     472    IF(ierr/=nf90_noerr) THEN
     473      WRITE(*, *) nf90_strerror(ierr)
     474      stop 'sens'
     475    endif
     476
     477    ierr = nf90_inq_varid(nid, "flat", var3didin(33))
     478    IF(ierr/=nf90_noerr) THEN
     479      WRITE(*, *) nf90_strerror(ierr)
     480      stop 'flat'
     481    endif
     482
     483    ierr = nf90_inq_varid(nid, "ts", var3didin(34))
     484    IF(ierr/=nf90_noerr) THEN
     485      WRITE(*, *) nf90_strerror(ierr)
     486      stop 'ts'
     487    endif
     488
     489    ierr = nf90_inq_varid(nid, "ustar", var3didin(35))
     490    IF(ierr/=nf90_noerr) THEN
     491      WRITE(*, *) nf90_strerror(ierr)
     492      stop 'ustar'
     493    endif
     494
     495    ierr = nf90_inq_varid(nid, "uw", var3didin(36))
     496    IF(ierr/=nf90_noerr) THEN
     497      WRITE(*, *) nf90_strerror(ierr)
     498      stop 'uw'
     499    endif
     500
     501    ierr = nf90_inq_varid(nid, "vw", var3didin(37))
     502    IF(ierr/=nf90_noerr) THEN
     503      WRITE(*, *) nf90_strerror(ierr)
     504      stop 'vw'
     505    endif
     506
     507    ierr = nf90_inq_varid(nid, "q1", var3didin(38))
     508    IF(ierr/=nf90_noerr) THEN
     509      WRITE(*, *) nf90_strerror(ierr)
     510      stop 'q1'
     511    endif
     512
     513    ierr = nf90_inq_varid(nid, "q2", var3didin(39))
     514    IF(ierr/=nf90_noerr) THEN
     515      WRITE(*, *) nf90_strerror(ierr)
     516      stop 'q2'
     517    endif
     518
     519    ierr = nf90_get_var(nid, var3didin(1), zz)
     520    IF(ierr/=nf90_noerr) THEN
     521      WRITE(*, *) nf90_strerror(ierr)
     522      stop "getvarup"
     523    endif
     524    !          WRITE(*,*)'lecture z ok',zz
     525
     526    ierr = nf90_get_var(nid, var3didin(2), pp)
     527    IF(ierr/=nf90_noerr) THEN
     528      WRITE(*, *) nf90_strerror(ierr)
     529      stop "getvarup"
     530    endif
     531    !          WRITE(*,*)'lecture pp ok',pp
     532
     533    ierr = nf90_get_var(nid, var3didin(3), temp)
     534    IF(ierr/=nf90_noerr) THEN
     535      WRITE(*, *) nf90_strerror(ierr)
     536      stop "getvarup"
     537    endif
     538    !          WRITE(*,*)'lecture T ok',temp
     539
     540    ierr = nf90_get_var(nid, var3didin(4), qv)
     541    IF(ierr/=nf90_noerr) THEN
     542      WRITE(*, *) nf90_strerror(ierr)
     543      stop "getvarup"
     544    endif
     545    !          WRITE(*,*)'lecture qv ok',qv
     546
     547    ierr = nf90_get_var(nid, var3didin(5), rh)
     548    IF(ierr/=nf90_noerr) THEN
     549      WRITE(*, *) nf90_strerror(ierr)
     550      stop "getvarup"
     551    endif
     552    !          WRITE(*,*)'lecture rh ok',rh
     553
     554    ierr = nf90_get_var(nid, var3didin(6), theta)
     555    IF(ierr/=nf90_noerr) THEN
     556      WRITE(*, *) nf90_strerror(ierr)
     557      stop "getvarup"
     558    endif
     559    !          WRITE(*,*)'lecture theta ok',theta
     560
     561    ierr = nf90_get_var(nid, var3didin(7), rv)
     562    IF(ierr/=nf90_noerr) THEN
     563      WRITE(*, *) nf90_strerror(ierr)
     564      stop "getvarup"
     565    endif
     566    !          WRITE(*,*)'lecture rv ok',rv
     567
     568    ierr = nf90_get_var(nid, var3didin(8), u)
     569    IF(ierr/=nf90_noerr) THEN
     570      WRITE(*, *) nf90_strerror(ierr)
     571      stop "getvarup"
     572    endif
     573    !          WRITE(*,*)'lecture u ok',u
     574
     575    ierr = nf90_get_var(nid, var3didin(9), v)
     576    IF(ierr/=nf90_noerr) THEN
     577      WRITE(*, *) nf90_strerror(ierr)
     578      stop "getvarup"
     579    endif
     580    !          WRITE(*,*)'lecture v ok',v
     581
     582    ierr = nf90_get_var(nid, var3didin(10), ug)
     583    IF(ierr/=nf90_noerr) THEN
     584      WRITE(*, *) nf90_strerror(ierr)
     585      stop "getvarup"
     586    endif
     587    !          WRITE(*,*)'lecture ug ok',ug
     588
     589    ierr = nf90_get_var(nid, var3didin(11), vg)
     590    IF(ierr/=nf90_noerr) THEN
     591      WRITE(*, *) nf90_strerror(ierr)
     592      stop "getvarup"
     593    endif
     594    !          WRITE(*,*)'lecture vg ok',vg
     595
     596    ierr = nf90_get_var(nid, var3didin(12), w)
     597    IF(ierr/=nf90_noerr) THEN
     598      WRITE(*, *) nf90_strerror(ierr)
     599      stop "getvarup"
     600    endif
     601    !          WRITE(*,*)'lecture w ok',w
     602
     603    ierr = nf90_get_var(nid, var3didin(13), du)
     604    IF(ierr/=nf90_noerr) THEN
     605      WRITE(*, *) nf90_strerror(ierr)
     606      stop "getvarup"
     607    endif
     608    !          WRITE(*,*)'lecture du ok',du
     609
     610    ierr = nf90_get_var(nid, var3didin(14), hu)
     611    IF(ierr/=nf90_noerr) THEN
     612      WRITE(*, *) nf90_strerror(ierr)
     613      stop "getvarup"
     614    endif
     615    !          WRITE(*,*)'lecture hu ok',hu
     616
     617    ierr = nf90_get_var(nid, var3didin(15), vu)
     618    IF(ierr/=nf90_noerr) THEN
     619      WRITE(*, *) nf90_strerror(ierr)
     620      stop "getvarup"
     621    endif
     622    !          WRITE(*,*)'lecture vu ok',vu
     623
     624    ierr = nf90_get_var(nid, var3didin(16), dv)
     625    IF(ierr/=nf90_noerr) THEN
     626      WRITE(*, *) nf90_strerror(ierr)
     627      stop "getvarup"
     628    endif
     629    !          WRITE(*,*)'lecture dv ok',dv
     630
     631    ierr = nf90_get_var(nid, var3didin(17), hv)
     632    IF(ierr/=nf90_noerr) THEN
     633      WRITE(*, *) nf90_strerror(ierr)
     634      stop "getvarup"
     635    endif
     636    !          WRITE(*,*)'lecture hv ok',hv
     637
     638    ierr = nf90_get_var(nid, var3didin(18), vv)
     639    IF(ierr/=nf90_noerr) THEN
     640      WRITE(*, *) nf90_strerror(ierr)
     641      stop "getvarup"
     642    endif
     643    !          WRITE(*,*)'lecture vv ok',vv
     644
     645    ierr = nf90_get_var(nid, var3didin(19), dt)
     646    IF(ierr/=nf90_noerr) THEN
     647      WRITE(*, *) nf90_strerror(ierr)
     648      stop "getvarup"
     649    endif
     650    !          WRITE(*,*)'lecture dt ok',dt
     651
     652    ierr = nf90_get_var(nid, var3didin(20), ht)
     653    IF(ierr/=nf90_noerr) THEN
     654      WRITE(*, *) nf90_strerror(ierr)
     655      stop "getvarup"
     656    endif
     657    !          WRITE(*,*)'lecture ht ok',ht
     658
     659    ierr = nf90_get_var(nid, var3didin(21), vt)
     660    IF(ierr/=nf90_noerr) THEN
     661      WRITE(*, *) nf90_strerror(ierr)
     662      stop "getvarup"
     663    endif
     664    !          WRITE(*,*)'lecture vt ok',vt
     665
     666    ierr = nf90_get_var(nid, var3didin(22), dq)
     667    IF(ierr/=nf90_noerr) THEN
     668      WRITE(*, *) nf90_strerror(ierr)
     669      stop "getvarup"
     670    endif
     671    !          WRITE(*,*)'lecture dq ok',dq
     672
     673    ierr = nf90_get_var(nid, var3didin(23), hq)
     674    IF(ierr/=nf90_noerr) THEN
     675      WRITE(*, *) nf90_strerror(ierr)
     676      stop "getvarup"
     677    endif
     678    !          WRITE(*,*)'lecture hq ok',hq
     679
     680    ierr = nf90_get_var(nid, var3didin(24), vq)
     681    IF(ierr/=nf90_noerr) THEN
     682      WRITE(*, *) nf90_strerror(ierr)
     683      stop "getvarup"
     684    endif
     685    !          WRITE(*,*)'lecture vq ok',vq
     686
     687    ierr = nf90_get_var(nid, var3didin(25), dth)
     688    IF(ierr/=nf90_noerr) THEN
     689      WRITE(*, *) nf90_strerror(ierr)
     690      stop "getvarup"
     691    endif
     692    !          WRITE(*,*)'lecture dth ok',dth
     693
     694    ierr = nf90_get_var(nid, var3didin(26), hth)
     695    IF(ierr/=nf90_noerr) THEN
     696      WRITE(*, *) nf90_strerror(ierr)
     697      stop "getvarup"
     698    endif
     699    !          WRITE(*,*)'lecture hth ok',hth
     700
     701    ierr = nf90_get_var(nid, var3didin(27), vth)
     702    IF(ierr/=nf90_noerr) THEN
     703      WRITE(*, *) nf90_strerror(ierr)
     704      stop "getvarup"
     705    endif
     706    !          WRITE(*,*)'lecture vth ok',vth
     707
     708    ierr = nf90_get_var(nid, var3didin(28), dr)
     709    IF(ierr/=nf90_noerr) THEN
     710      WRITE(*, *) nf90_strerror(ierr)
     711      stop "getvarup"
     712    endif
     713    !          WRITE(*,*)'lecture dr ok',dr
     714
     715    ierr = nf90_get_var(nid, var3didin(29), hr)
     716    IF(ierr/=nf90_noerr) THEN
     717      WRITE(*, *) nf90_strerror(ierr)
     718      stop "getvarup"
     719    endif
     720    !          WRITE(*,*)'lecture hr ok',hr
     721
     722    ierr = nf90_get_var(nid, var3didin(30), vr)
     723    IF(ierr/=nf90_noerr) THEN
     724      WRITE(*, *) nf90_strerror(ierr)
     725      stop "getvarup"
     726    endif
     727    !          WRITE(*,*)'lecture vr ok',vr
     728
     729    ierr = nf90_get_var(nid, var3didin(31), dtrad)
     730    IF(ierr/=nf90_noerr) THEN
     731      WRITE(*, *) nf90_strerror(ierr)
     732      stop "getvarup"
     733    endif
     734    !          WRITE(*,*)'lecture dtrad ok',dtrad
     735
     736    ierr = nf90_get_var(nid, var3didin(32), sens)
     737    IF(ierr/=nf90_noerr) THEN
     738      WRITE(*, *) nf90_strerror(ierr)
     739      stop "getvarup"
     740    endif
     741    !          WRITE(*,*)'lecture sens ok',sens
     742
     743    ierr = nf90_get_var(nid, var3didin(33), flat)
     744    IF(ierr/=nf90_noerr) THEN
     745      WRITE(*, *) nf90_strerror(ierr)
     746      stop "getvarup"
     747    endif
     748    !          WRITE(*,*)'lecture flat ok',flat
     749
     750    ierr = nf90_get_var(nid, var3didin(34), ts)
     751    IF(ierr/=nf90_noerr) THEN
     752      WRITE(*, *) nf90_strerror(ierr)
     753      stop "getvarup"
     754    endif
     755    !          WRITE(*,*)'lecture ts ok',ts
     756
     757    ierr = nf90_get_var(nid, var3didin(35), ustar)
     758    IF(ierr/=nf90_noerr) THEN
     759      WRITE(*, *) nf90_strerror(ierr)
     760      stop "getvarup"
     761    endif
     762    !         WRITE(*,*)'lecture ustar ok',ustar
     763
     764    ierr = nf90_get_var(nid, var3didin(36), uw)
     765    IF(ierr/=nf90_noerr) THEN
     766      WRITE(*, *) nf90_strerror(ierr)
     767      stop "getvarup"
     768    endif
     769    !         WRITE(*,*)'lecture uw ok',uw
     770
     771    ierr = nf90_get_var(nid, var3didin(37), vw)
     772    IF(ierr/=nf90_noerr) THEN
     773      WRITE(*, *) nf90_strerror(ierr)
     774      stop "getvarup"
     775    endif
     776    !         WRITE(*,*)'lecture vw ok',vw
     777
     778    ierr = nf90_get_var(nid, var3didin(38), q1)
     779    IF(ierr/=nf90_noerr) THEN
     780      WRITE(*, *) nf90_strerror(ierr)
     781      stop "getvarup"
     782    endif
     783    !         WRITE(*,*)'lecture q1 ok',q1
     784
     785    ierr = nf90_get_var(nid, var3didin(39), q2)
     786    IF(ierr/=nf90_noerr) THEN
     787      WRITE(*, *) nf90_strerror(ierr)
     788      stop "getvarup"
     789    endif
     790    !         WRITE(*,*)'lecture q2 ok',q2
     791
     792  END SUBROUTINE  read_cas
     793  !======================================================================
     794  SUBROUTINE interp_case_time(day, day1, annee_ref                &
     795          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
     796          , nt_cas, nlev_cas                                       &
     797          , ts_cas, plev_cas, t_cas, q_cas, u_cas, v_cas               &
     798          , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas           &
     799          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas   &
     800          , dq_cas, hq_cas, vq_cas, lat_cas, sens_cas, ustar_cas       &
     801          , uw_cas, vw_cas, q1_cas, q2_cas                           &
     802          , ts_prof_cas, plev_prof_cas, t_prof_cas, q_prof_cas       &
     803          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas         &
     804          , vitw_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas     &
     805          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas       &
     806          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas    &
     807          , hq_prof_cas, vq_prof_cas, lat_prof_cas, sens_prof_cas    &
     808          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas)
     809
     810    USE lmdz_compar1d
     811    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     812
     813    IMPLICIT NONE
     814
     815    !---------------------------------------------------------------------------------------
     816    ! Time interpolation of a 2D field to the timestep corresponding to day
     817
     818    ! day: current julian day (e.g. 717538.2)
     819    ! day1: first day of the simulation
     820    ! nt_cas: total nb of data in the forcing
     821    ! pdt_cas: total time interval (in sec) between 2 forcing data
     822    !---------------------------------------------------------------------------------------
     823
     824    ! inputs:
     825    INTEGER annee_ref
     826    INTEGER nt_cas, nlev_cas
     827    REAL day, day1, day_cas
     828    REAL ts_cas(nt_cas)
     829    REAL plev_cas(nlev_cas, nt_cas)
     830    REAL t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas)
     831    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
     832    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
     833    REAL vitw_cas(nlev_cas, nt_cas)
     834    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
     835    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
     836    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
     837    REAL dtrad_cas(nlev_cas, nt_cas)
     838    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
     839    REAL lat_cas(nt_cas)
     840    REAL sens_cas(nt_cas)
     841    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
     842    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
     843
     844    ! outputs:
     845    REAL plev_prof_cas(nlev_cas)
     846    REAL t_prof_cas(nlev_cas), q_prof_cas(nlev_cas)
     847    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
     848    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
     849    REAL vitw_prof_cas(nlev_cas)
     850    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
     851    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
     852    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
     853    REAL dtrad_prof_cas(nlev_cas)
     854    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
     855    REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas
     856    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
     857    ! local:
     858    INTEGER it_cas1, it_cas2, k
     859    REAL timeit, time_cas1, time_cas2, frac
     860
     861    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
     862
     863    ! On teste si la date du cas AMMA est correcte.
     864    ! C est pour memoire car en fait les fichiers .def
     865    ! sont censes etre corrects.
     866    ! A supprimer a terme (MPL 20150623)
     867    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
     868    ! Check that initial day of the simulation consistent with AMMA case:
     869    !      if (annee_ref.NE.2006) THEN
     870    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
     871    !       PRINT*,'Changer annee_ref dans run.def'
     872    !       stop
     873    !      endif
     874    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
     875    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     876    !       PRINT*,'Changer dayref dans run.def'
     877    !       stop
     878    !      endif
     879    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
     880    !       PRINT*,'AMMA a fini le 11 juillet'
     881    !       PRINT*,'Changer dayref ou nday dans run.def'
     882    !       stop
     883    !      endif
     884    !      endif
     885
     886    ! Determine timestep relative to the 1st day:
     887    !       timeit=(day-day1)*86400.
     888    !       if (annee_ref.EQ.1992) THEN
     889    !        timeit=(day-day_cas)*86400.
     890    !       else
     891    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     892    !       endif
     893    timeit = (day - day_ju_ini_cas) * 86400
     894    print *, 'day=', day
     895    print *, 'day_ju_ini_cas=', day_ju_ini_cas
     896    print *, 'pdt_cas=', pdt_cas
     897    print *, 'timeit=', timeit
     898    print *, 'nt_cas=', nt_cas
     899
     900    ! Determine the closest observation times:
     901    !       it_cas1=INT(timeit/pdt_cas)+1
     902    !       it_cas2=it_cas1 + 1
     903    !       time_cas1=(it_cas1-1)*pdt_cas
     904    !       time_cas2=(it_cas2-1)*pdt_cas
     905
     906    it_cas1 = INT(timeit / pdt_cas) + 1
     907    IF (it_cas1 == nt_cas) THEN
     908      it_cas2 = it_cas1
     909    ELSE
     910      it_cas2 = it_cas1 + 1
     911    ENDIF
     912    time_cas1 = (it_cas1 - 1) * pdt_cas
     913    time_cas2 = (it_cas2 - 1) * pdt_cas
     914    print *, 'it_cas1=', it_cas1
     915    print *, 'it_cas2=', it_cas2
     916    print *, 'time_cas1=', time_cas1
     917    print *, 'time_cas2=', time_cas2
     918
     919    IF (it_cas1 > nt_cas) THEN
     920      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     921              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
     922      stop
     923    endif
     924
     925    ! time interpolation:
     926    IF (it_cas1 == it_cas2) THEN
     927      frac = 0.
     928    ELSE
     929      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
     930      frac = max(frac, 0.0)
     931    ENDIF
     932
     933    lat_prof_cas = lat_cas(it_cas2)                                       &
     934            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
     935    sens_prof_cas = sens_cas(it_cas2)                                     &
     936            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
     937    ts_prof_cas = ts_cas(it_cas2)                                         &
     938            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
     939    ustar_prof_cas = ustar_cas(it_cas2)                                   &
     940            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
     941
     942    DO k = 1, nlev_cas
     943      plev_prof_cas(k) = plev_cas(k, it_cas2)                               &
     944              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
     945      t_prof_cas(k) = t_cas(k, it_cas2)                               &
     946              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
     947      q_prof_cas(k) = q_cas(k, it_cas2)                               &
     948              - frac * (q_cas(k, it_cas2) - q_cas(k, it_cas1))
     949      u_prof_cas(k) = u_cas(k, it_cas2)                               &
     950              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
     951      v_prof_cas(k) = v_cas(k, it_cas2)                               &
     952              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
     953      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
     954              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
     955      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
     956              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
     957      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                               &
     958              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
     959      du_prof_cas(k) = du_cas(k, it_cas2)                                   &
     960              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
     961      hu_prof_cas(k) = hu_cas(k, it_cas2)                                   &
     962              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
     963      vu_prof_cas(k) = vu_cas(k, it_cas2)                                   &
     964              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
     965      dv_prof_cas(k) = dv_cas(k, it_cas2)                                   &
     966              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
     967      hv_prof_cas(k) = hv_cas(k, it_cas2)                                   &
     968              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
     969      vv_prof_cas(k) = vv_cas(k, it_cas2)                                   &
     970              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
     971      dt_prof_cas(k) = dt_cas(k, it_cas2)                                   &
     972              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
     973      ht_prof_cas(k) = ht_cas(k, it_cas2)                                   &
     974              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
     975      vt_prof_cas(k) = vt_cas(k, it_cas2)                                   &
     976              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
     977      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                                   &
     978              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
     979      dq_prof_cas(k) = dq_cas(k, it_cas2)                                   &
     980              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
     981      hq_prof_cas(k) = hq_cas(k, it_cas2)                                   &
     982              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
     983      vq_prof_cas(k) = vq_cas(k, it_cas2)                                   &
     984              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
     985      uw_prof_cas(k) = uw_cas(k, it_cas2)                                   &
     986              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
     987      vw_prof_cas(k) = vw_cas(k, it_cas2)                                   &
     988              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
     989      q1_prof_cas(k) = q1_cas(k, it_cas2)                                   &
     990              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
     991      q2_prof_cas(k) = q2_cas(k, it_cas2)                                   &
     992              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
     993    enddo
     994
     995    RETURN
     996  END
     997
     998  !**********************************************************************************************
    1011999END MODULE mod_1D_cases_read

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

    r5135 r5158  
    1 
    21! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
    32
    43MODULE mod_1D_cases_read2
    5   USE netcdf, ONLY: nf90_get_var,nf90_noerr,nf90_inq_varid,nf90_inquire_dimension,nf90_strerror,nf90_open,&
    6           nf90_nowrite,nf90_inq_dimid
    7 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     4  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_inq_varid, nf90_inquire_dimension, nf90_strerror, nf90_open, &
     5          nf90_nowrite, nf90_inq_dimid
     6  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    87  !Declarations specifiques au cas standard
    98  CHARACTER*80 :: fich_cas
    10   ! Discr?tisation 
     9  ! Discr?tisation
    1110  INTEGER nlev_cas, nt_cas
    1211
    1312
    1413  !profils environnementaux
    15   REAL, ALLOCATABLE::  plev_cas(:,:),plevh_cas(:)
    16   REAL, ALLOCATABLE::  ap_cas(:),bp_cas(:)
    17 
    18   REAL, ALLOCATABLE::  z_cas(:,:),zh_cas(:)
    19   REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
    20   REAL, ALLOCATABLE::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
    21   REAL, ALLOCATABLE::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
     14  REAL, ALLOCATABLE :: plev_cas(:, :), plevh_cas(:)
     15  REAL, ALLOCATABLE :: ap_cas(:), bp_cas(:)
     16
     17  REAL, ALLOCATABLE :: z_cas(:, :), zh_cas(:)
     18  REAL, ALLOCATABLE :: t_cas(:, :), q_cas(:, :), qv_cas(:, :), ql_cas(:, :), qi_cas(:, :), rh_cas(:, :)
     19  REAL, ALLOCATABLE :: th_cas(:, :), thv_cas(:, :), thl_cas(:, :), rv_cas(:, :)
     20  REAL, ALLOCATABLE :: u_cas(:, :), v_cas(:, :), vitw_cas(:, :), omega_cas(:, :)
    2221
    2322  !forcing
    24   REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
    25   REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
    26   REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
    27   REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
    28   REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
    29   REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
    30   REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
    31   REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
    32   REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
     23  REAL, ALLOCATABLE :: ht_cas(:, :), vt_cas(:, :), dt_cas(:, :), dtrad_cas(:, :)
     24  REAL, ALLOCATABLE :: hth_cas(:, :), vth_cas(:, :), dth_cas(:, :)
     25  REAL, ALLOCATABLE :: hq_cas(:, :), vq_cas(:, :), dq_cas(:, :)
     26  REAL, ALLOCATABLE :: hr_cas(:, :), vr_cas(:, :), dr_cas(:, :)
     27  REAL, ALLOCATABLE :: hu_cas(:, :), vu_cas(:, :), du_cas(:, :)
     28  REAL, ALLOCATABLE :: hv_cas(:, :), vv_cas(:, :), dv_cas(:, :)
     29  REAL, ALLOCATABLE :: ug_cas(:, :), vg_cas(:, :)
     30  REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), ts_cas(:), ps_cas(:), ustar_cas(:)
     31  REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :), tke_cas(:)
    3332
    3433  !champs interpoles
    35   REAL, ALLOCATABLE::  plev_prof_cas(:)
    36   REAL, ALLOCATABLE::  t_prof_cas(:)
    37   REAL, ALLOCATABLE::  theta_prof_cas(:)
    38   REAL, ALLOCATABLE::  thl_prof_cas(:)
    39   REAL, ALLOCATABLE::  thv_prof_cas(:)
    40   REAL, ALLOCATABLE::  q_prof_cas(:)
    41   REAL, ALLOCATABLE::  qv_prof_cas(:)
    42   REAL, ALLOCATABLE::  ql_prof_cas(:)
    43   REAL, ALLOCATABLE::  qi_prof_cas(:)
    44   REAL, ALLOCATABLE::  rh_prof_cas(:)
    45   REAL, ALLOCATABLE::  rv_prof_cas(:)
    46   REAL, ALLOCATABLE::  u_prof_cas(:)
    47   REAL, ALLOCATABLE::  v_prof_cas(:)
    48   REAL, ALLOCATABLE::  vitw_prof_cas(:)
    49   REAL, ALLOCATABLE::  omega_prof_cas(:)
    50   REAL, ALLOCATABLE::  ug_prof_cas(:)
    51   REAL, ALLOCATABLE::  vg_prof_cas(:)
    52   REAL, ALLOCATABLE::  ht_prof_cas(:)
    53   REAL, ALLOCATABLE::  hth_prof_cas(:)
    54   REAL, ALLOCATABLE::  hq_prof_cas(:)
    55   REAL, ALLOCATABLE::  vt_prof_cas(:)
    56   REAL, ALLOCATABLE::  vth_prof_cas(:)
    57   REAL, ALLOCATABLE::  vq_prof_cas(:)
    58   REAL, ALLOCATABLE::  dt_prof_cas(:)
    59   REAL, ALLOCATABLE::  dth_prof_cas(:)
    60   REAL, ALLOCATABLE::  dtrad_prof_cas(:)
    61   REAL, ALLOCATABLE::  dq_prof_cas(:)
    62   REAL, ALLOCATABLE::  hu_prof_cas(:)
    63   REAL, ALLOCATABLE::  hv_prof_cas(:)
    64   REAL, ALLOCATABLE::  vu_prof_cas(:)
    65   REAL, ALLOCATABLE::  vv_prof_cas(:)
    66   REAL, ALLOCATABLE::  du_prof_cas(:)
    67   REAL, ALLOCATABLE::  dv_prof_cas(:)
    68   REAL, ALLOCATABLE::  uw_prof_cas(:)
    69   REAL, ALLOCATABLE::  vw_prof_cas(:)
    70   REAL, ALLOCATABLE::  q1_prof_cas(:)
    71   REAL, ALLOCATABLE::  q2_prof_cas(:)
    72 
    73 
    74   REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
    75   REAL o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
    76 
     34  REAL, ALLOCATABLE :: plev_prof_cas(:)
     35  REAL, ALLOCATABLE :: t_prof_cas(:)
     36  REAL, ALLOCATABLE :: theta_prof_cas(:)
     37  REAL, ALLOCATABLE :: thl_prof_cas(:)
     38  REAL, ALLOCATABLE :: thv_prof_cas(:)
     39  REAL, ALLOCATABLE :: q_prof_cas(:)
     40  REAL, ALLOCATABLE :: qv_prof_cas(:)
     41  REAL, ALLOCATABLE :: ql_prof_cas(:)
     42  REAL, ALLOCATABLE :: qi_prof_cas(:)
     43  REAL, ALLOCATABLE :: rh_prof_cas(:)
     44  REAL, ALLOCATABLE :: rv_prof_cas(:)
     45  REAL, ALLOCATABLE :: u_prof_cas(:)
     46  REAL, ALLOCATABLE :: v_prof_cas(:)
     47  REAL, ALLOCATABLE :: vitw_prof_cas(:)
     48  REAL, ALLOCATABLE :: omega_prof_cas(:)
     49  REAL, ALLOCATABLE :: ug_prof_cas(:)
     50  REAL, ALLOCATABLE :: vg_prof_cas(:)
     51  REAL, ALLOCATABLE :: ht_prof_cas(:)
     52  REAL, ALLOCATABLE :: hth_prof_cas(:)
     53  REAL, ALLOCATABLE :: hq_prof_cas(:)
     54  REAL, ALLOCATABLE :: vt_prof_cas(:)
     55  REAL, ALLOCATABLE :: vth_prof_cas(:)
     56  REAL, ALLOCATABLE :: vq_prof_cas(:)
     57  REAL, ALLOCATABLE :: dt_prof_cas(:)
     58  REAL, ALLOCATABLE :: dth_prof_cas(:)
     59  REAL, ALLOCATABLE :: dtrad_prof_cas(:)
     60  REAL, ALLOCATABLE :: dq_prof_cas(:)
     61  REAL, ALLOCATABLE :: hu_prof_cas(:)
     62  REAL, ALLOCATABLE :: hv_prof_cas(:)
     63  REAL, ALLOCATABLE :: vu_prof_cas(:)
     64  REAL, ALLOCATABLE :: vv_prof_cas(:)
     65  REAL, ALLOCATABLE :: du_prof_cas(:)
     66  REAL, ALLOCATABLE :: dv_prof_cas(:)
     67  REAL, ALLOCATABLE :: uw_prof_cas(:)
     68  REAL, ALLOCATABLE :: vw_prof_cas(:)
     69  REAL, ALLOCATABLE :: q1_prof_cas(:)
     70  REAL, ALLOCATABLE :: q2_prof_cas(:)
     71
     72  REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ps_prof_cas, ustar_prof_cas, tke_prof_cas
     73  REAL o3_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, rugos_cas, sand_cas, clay_cas
    7774
    7875
    … …  
    8279    IMPLICIT NONE
    8380
    84     INTEGER nid,rid,ierr
    85     INTEGER ii,jj
    86 
    87     fich_cas='setup/cas.nc'
    88     PRINT*,'fich_cas ',fich_cas
    89     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    90     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
     81    INTEGER nid, rid, ierr
     82    INTEGER ii, jj
     83
     84    fich_cas = 'setup/cas.nc'
     85    PRINT*, 'fich_cas ', fich_cas
     86    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
     87    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
    9188    IF (ierr/=nf90_noerr) THEN
    92        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    93        WRITE(*,*) nf90_strerror(ierr)
    94        stop ""
     89      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
     90      WRITE(*, *) nf90_strerror(ierr)
     91      stop ""
    9592    endif
    9693    !.......................................................................
    97     ierr=nf90_inq_dimid(nid,'lat',rid)
     94    ierr = nf90_inq_dimid(nid, 'lat', rid)
    9895    IF (ierr/=nf90_noerr) THEN
    99        PRINT*, 'Oh probleme lecture dimension lat'
    100     ENDIF
    101     ierr=nf90_inquire_dimension(nid,rid,len=ii)
    102     PRINT*,'OK1 nid,rid,lat',nid,rid,ii
     96      PRINT*, 'Oh probleme lecture dimension lat'
     97    ENDIF
     98    ierr = nf90_inquire_dimension(nid, rid, len = ii)
     99    PRINT*, 'OK1 nid,rid,lat', nid, rid, ii
    103100    !.......................................................................
    104     ierr=nf90_inq_dimid(nid,'lon',rid)
     101    ierr = nf90_inq_dimid(nid, 'lon', rid)
    105102    IF (ierr/=nf90_noerr) THEN
    106        PRINT*, 'Oh probleme lecture dimension lon'
    107     ENDIF
    108     ierr=nf90_inquire_dimension(nid,rid,len=jj)
    109     PRINT*,'OK2 nid,rid,lat',nid,rid,jj
     103      PRINT*, 'Oh probleme lecture dimension lon'
     104    ENDIF
     105    ierr = nf90_inquire_dimension(nid, rid, len = jj)
     106    PRINT*, 'OK2 nid,rid,lat', nid, rid, jj
    110107    !.......................................................................
    111     ierr=nf90_inq_dimid(nid,'lev',rid)
     108    ierr = nf90_inq_dimid(nid, 'lev', rid)
    112109    IF (ierr/=nf90_noerr) THEN
    113        PRINT*, 'Oh probleme lecture dimension zz'
    114     ENDIF
    115     ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
    116     PRINT*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
     110      PRINT*, 'Oh probleme lecture dimension zz'
     111    ENDIF
     112    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
     113    PRINT*, 'OK3 nid,rid,nlev_cas', nid, rid, nlev_cas
    117114    !.......................................................................
    118     ierr=nf90_inq_dimid(nid,'time',rid)
    119     PRINT*,'nid,rid',nid,rid
    120     nt_cas=0
     115    ierr = nf90_inq_dimid(nid, 'time', rid)
     116    PRINT*, 'nid,rid', nid, rid
     117    nt_cas = 0
    121118    IF (ierr/=nf90_noerr) THEN
    122        stop 'probleme lecture dimension sens'
    123     ENDIF
    124     ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
    125     PRINT*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
    126 
    127 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     119      stop 'probleme lecture dimension sens'
     120    ENDIF
     121    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
     122    PRINT*, 'OK4 nid,rid,nt_cas', nid, rid, nt_cas
     123
     124    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    128125    !profils moyens:
    129     allocate(plev_cas(nlev_cas,nt_cas))       
    130     allocate(z_cas(nlev_cas,nt_cas))
    131     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    132     allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
    133     allocate(u_cas(nlev_cas,nt_cas))
    134     allocate(v_cas(nlev_cas,nt_cas))
     126    allocate(plev_cas(nlev_cas, nt_cas))
     127    allocate(z_cas(nlev_cas, nt_cas))
     128    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
     129    allocate(th_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
     130    allocate(u_cas(nlev_cas, nt_cas))
     131    allocate(v_cas(nlev_cas, nt_cas))
    135132
    136133    !forcing
    137     allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
    138     allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    139     allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    140     allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    141     allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    142     allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    143     allocate(vitw_cas(nlev_cas,nt_cas))
    144     allocate(ug_cas(nlev_cas,nt_cas))
    145     allocate(vg_cas(nlev_cas,nt_cas))
    146     allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas))
    147     allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
     134    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
     135    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
     136    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
     137    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
     138    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
     139    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
     140    allocate(vitw_cas(nlev_cas, nt_cas))
     141    allocate(ug_cas(nlev_cas, nt_cas))
     142    allocate(vg_cas(nlev_cas, nt_cas))
     143    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas))
     144    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
    148145
    149146
    … …  
    176173    allocate(q2_prof_cas(nlev_cas))
    177174
    178     PRINT*,'Allocations OK'
    179     CALL read_cas2(nid,nlev_cas,nt_cas                                       &
    180          ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
    181          ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
    182          ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
    183          ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
    184          ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    185     PRINT*,'Read cas OK'
    186 
     175    PRINT*, 'Allocations OK'
     176    CALL read_cas2(nid, nlev_cas, nt_cas                                       &
     177            , z_cas, plev_cas, t_cas, q_cas, rh_cas, th_cas, rv_cas, u_cas, v_cas         &
     178            , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas, dv_cas, hv_cas, vv_cas    &
     179            , dt_cas, dtrad_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas                 &
     180            , dth_cas, hth_cas, vth_cas, dr_cas, hr_cas, vr_cas, sens_cas, lat_cas, ts_cas&
     181            , ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas)
     182    PRINT*, 'Read cas OK'
    187183
    188184  END SUBROUTINE read_1D_cas
    … …  
    191187    IMPLICIT NONE
    192188
    193     INTEGER nid,rid,ierr
    194     INTEGER ii,jj
    195 
    196     fich_cas='setup/cas.nc'
    197     PRINT*,'fich_cas ',fich_cas
    198     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    199     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
     189    INTEGER nid, rid, ierr
     190    INTEGER ii, jj
     191
     192    fich_cas = 'setup/cas.nc'
     193    PRINT*, 'fich_cas ', fich_cas
     194    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
     195    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
    200196    IF (ierr/=nf90_noerr) THEN
    201        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    202        WRITE(*,*) nf90_strerror(ierr)
    203        stop ""
     197      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
     198      WRITE(*, *) nf90_strerror(ierr)
     199      stop ""
    204200    endif
    205201    !.......................................................................
    206     ierr=nf90_inq_dimid(nid,'lat',rid)
     202    ierr = nf90_inq_dimid(nid, 'lat', rid)
    207203    IF (ierr/=nf90_noerr) THEN
    208        PRINT*, 'Oh probleme lecture dimension lat'
    209     ENDIF
    210     ierr=nf90_inquire_dimension(nid,rid,len=ii)
    211     PRINT*,'OK1 read2: nid,rid,lat',nid,rid,ii
     204      PRINT*, 'Oh probleme lecture dimension lat'
     205    ENDIF
     206    ierr = nf90_inquire_dimension(nid, rid, len = ii)
     207    PRINT*, 'OK1 read2: nid,rid,lat', nid, rid, ii
    212208    !.......................................................................
    213     ierr=nf90_inq_dimid(nid,'lon',rid)
     209    ierr = nf90_inq_dimid(nid, 'lon', rid)
    214210    IF (ierr/=nf90_noerr) THEN
    215        PRINT*, 'Oh probleme lecture dimension lon'
    216     ENDIF
    217     ierr=nf90_inquire_dimension(nid,rid,len=jj)
    218     PRINT*,'OK2 read2: nid,rid,lat',nid,rid,jj
     211      PRINT*, 'Oh probleme lecture dimension lon'
     212    ENDIF
     213    ierr = nf90_inquire_dimension(nid, rid, len = jj)
     214    PRINT*, 'OK2 read2: nid,rid,lat', nid, rid, jj
    219215    !.......................................................................
    220     ierr=nf90_inq_dimid(nid,'nlev',rid)
     216    ierr = nf90_inq_dimid(nid, 'nlev', rid)
    221217    IF (ierr/=nf90_noerr) THEN
    222        PRINT*, 'Oh probleme lecture dimension nlev'
    223     ENDIF
    224     ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
    225     PRINT*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
     218      PRINT*, 'Oh probleme lecture dimension nlev'
     219    ENDIF
     220    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
     221    PRINT*, 'OK3 read2: nid,rid,nlev_cas', nid, rid, nlev_cas
    226222    !.......................................................................
    227     ierr=nf90_inq_dimid(nid,'time',rid)
    228     nt_cas=0
     223    ierr = nf90_inq_dimid(nid, 'time', rid)
     224    nt_cas = 0
    229225    IF (ierr/=nf90_noerr) THEN
    230        stop 'Oh probleme lecture dimension time'
    231     ENDIF
    232     ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
    233     PRINT*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
    234 
    235 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     226      stop 'Oh probleme lecture dimension time'
     227    ENDIF
     228    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
     229    PRINT*, 'OK4 read2: nid,rid,nt_cas', nid, rid, nt_cas
     230
     231    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    236232    !profils moyens:
    237     allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    238     allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    239     allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
    240     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
    241          qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    242     allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
    243     allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
     233    allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1))
     234    allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1))
     235    allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1))
     236    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), &
     237            qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
     238    allocate(th_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
     239    allocate(u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas), vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas))
    244240
    245241    !forcing
    246     allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
    247     allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    248     allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    249     allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    250     allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    251     allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    252     allocate(ug_cas(nlev_cas,nt_cas))
    253     allocate(vg_cas(nlev_cas,nt_cas))
    254     allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
    255     allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
     242    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
     243    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
     244    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
     245    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
     246    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
     247    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
     248    allocate(ug_cas(nlev_cas, nt_cas))
     249    allocate(vg_cas(nlev_cas, nt_cas))
     250    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas), tke_cas(nt_cas))
     251    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
    256252
    257253
    … …  
    296292    allocate(q2_prof_cas(nlev_cas))
    297293
    298     PRINT*,'Allocations OK'
    299     CALL read2_cas (nid,nlev_cas,nt_cas,                                                                    &
    300          ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
    301          ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas,        &
    302          dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,              &
    303          dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
    304          uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
    305          o3_cas,rugos_cas,clay_cas,sand_cas)
    306     PRINT*,'Read2 cas OK'
    307     do ii=1,nlev_cas
    308        PRINT*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
     294    PRINT*, 'Allocations OK'
     295    CALL read2_cas (nid, nlev_cas, nt_cas, &
     296            ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, &
     297            ql_cas, qi_cas, rh_cas, rv_cas, u_cas, v_cas, vitw_cas, omega_cas, ug_cas, vg_cas, du_cas, hu_cas, vu_cas, &
     298            dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, &
     299            dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, ps_cas, ustar_cas, tke_cas, &
     300            uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, &
     301            o3_cas, rugos_cas, clay_cas, sand_cas)
     302    PRINT*, 'Read2 cas OK'
     303    DO ii = 1, nlev_cas
     304      PRINT*, 'apres read2_cas, plev_cas=', ii, plev_cas(ii, 1)
    309305    enddo
    310 
    311306
    312307  END SUBROUTINE read2_1D_cas
    … …  
    314309  !**********************************************************************************************
    315310  SUBROUTINE old_read_SCM_cas
     311    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     312
    316313    IMPLICIT NONE
    317314
    318     INCLUDE "date_cas.h"
    319 
    320     INTEGER nid,rid,ierr
    321     INTEGER ii,jj,timeid
     315    INTEGER nid, rid, ierr
     316    INTEGER ii, jj, timeid
    322317    REAL, ALLOCATABLE :: time_val(:)
    323318
    324     fich_cas='cas.nc'
    325     PRINT*,'fich_cas ',fich_cas
    326     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
    327     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
     319    fich_cas = 'cas.nc'
     320    PRINT*, 'fich_cas ', fich_cas
     321    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
     322    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
    328323    IF (ierr/=nf90_noerr) THEN
    329        WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
    330        WRITE(*,*) nf90_strerror(ierr)
    331        stop ""
     324      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
     325      WRITE(*, *) nf90_strerror(ierr)
     326      stop ""
    332327    endif
    333328    !.......................................................................
    334     ierr=nf90_inq_dimid(nid,'lat',rid)
     329    ierr = nf90_inq_dimid(nid, 'lat', rid)
    335330    IF (ierr/=nf90_noerr) THEN
    336        PRINT*, 'Oh probleme lecture dimension lat'
    337     ENDIF
    338     ierr=nf90_inquire_dimension(nid,rid,len=ii)
    339     PRINT*,'OK1 read2: nid,rid,lat',nid,rid,ii
     331      PRINT*, 'Oh probleme lecture dimension lat'
     332    ENDIF
     333    ierr = nf90_inquire_dimension(nid, rid, len = ii)
     334    PRINT*, 'OK1 read2: nid,rid,lat', nid, rid, ii
    340335    !.......................................................................
    341     ierr=nf90_inq_dimid(nid,'lon',rid)
     336    ierr = nf90_inq_dimid(nid, 'lon', rid)
    342337    IF (ierr/=nf90_noerr) THEN
    343        PRINT*, 'Oh probleme lecture dimension lon'
    344     ENDIF
    345     ierr=nf90_inquire_dimension(nid,rid,len=jj)
    346     PRINT*,'OK2 read2: nid,rid,lat',nid,rid,jj
     338      PRINT*, 'Oh probleme lecture dimension lon'
     339    ENDIF
     340    ierr = nf90_inquire_dimension(nid, rid, len = jj)
     341    PRINT*, 'OK2 read2: nid,rid,lat', nid, rid, jj
    347342    !.......................................................................
    348     ierr=nf90_inq_dimid(nid,'lev',rid)
     343    ierr = nf90_inq_dimid(nid, 'lev', rid)
    349344    IF (ierr/=nf90_noerr) THEN
    350        PRINT*, 'Oh probleme lecture dimension nlev'
    351     ENDIF
    352     ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
    353     PRINT*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
    354     IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN
    355        PRINT*,'Valeur de nlev_cas peu probable'
    356        STOP
     345      PRINT*, 'Oh probleme lecture dimension nlev'
     346    ENDIF
     347    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
     348    PRINT*, 'OK3 read2: nid,rid,nlev_cas', nid, rid, nlev_cas
     349    IF (.NOT. (nlev_cas > 10 .AND. nlev_cas < 1000)) THEN
     350      PRINT*, 'Valeur de nlev_cas peu probable'
     351      STOP
    357352    ENDIF
    358353    !.......................................................................
    359     ierr=nf90_inq_dimid(nid,'time',rid)
    360     nt_cas=0
     354    ierr = nf90_inq_dimid(nid, 'time', rid)
     355    nt_cas = 0
    361356    IF (ierr/=nf90_noerr) THEN
    362        stop 'Oh probleme lecture dimension time'
    363     ENDIF
    364     ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
    365     PRINT*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
     357      stop 'Oh probleme lecture dimension time'
     358    ENDIF
     359    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
     360    PRINT*, 'OK4 read2: nid,rid,nt_cas', nid, rid, nt_cas
    366361    ! Lecture de l'axe des temps
    367     PRINT*,'LECTURE DU TEMPS'
    368     ierr=nf90_inq_varid(nid,'time',timeid)
     362    PRINT*, 'LECTURE DU TEMPS'
     363    ierr = nf90_inq_varid(nid, 'time', timeid)
    369364    IF(ierr/=nf90_noerr) THEN
    370        print *,'Variable time manquante dans cas.nc:'
    371        ierr=nf90_noerr
     365      print *, 'Variable time manquante dans cas.nc:'
     366      ierr = nf90_noerr
    372367    else
    373        allocate(time_val(nt_cas))
    374        ierr = nf90_get_var(nid,timeid,time_val)
    375        IF(ierr/=nf90_noerr) THEN
    376           print *,'Pb a la lecture de time cas.nc: '
    377        endif
     368      allocate(time_val(nt_cas))
     369      ierr = nf90_get_var(nid, timeid, time_val)
     370      IF(ierr/=nf90_noerr) THEN
     371        print *, 'Pb a la lecture de time cas.nc: '
     372      endif
    378373    endif
    379374    IF (nt_cas>1) THEN
    380        pdt_cas=time_val(2)-time_val(1)
     375      pdt_cas = time_val(2) - time_val(1)
    381376    ELSE
    382        pdt_cas=0.
    383     ENDIF
    384 
    385 
    386 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     377      pdt_cas = 0.
     378    ENDIF
     379
     380
     381    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    387382    !profils moyens:
    388     allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    389     allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    390     allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
    391     allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
    392          qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    393     allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
    394     allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
     383    allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1))
     384    allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1))
     385    allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1))
     386    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), &
     387            qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
     388    allocate(th_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
     389    allocate(u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas), vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas))
    395390
    396391    !forcing
    397     allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
    398     allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    399     allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    400     allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    401     allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    402     allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    403     allocate(ug_cas(nlev_cas,nt_cas))
    404     allocate(vg_cas(nlev_cas,nt_cas))
    405     allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
    406     allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
     392    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
     393    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
     394    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
     395    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
     396    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
     397    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
     398    allocate(ug_cas(nlev_cas, nt_cas))
     399    allocate(vg_cas(nlev_cas, nt_cas))
     400    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas), tke_cas(nt_cas))
     401    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
    407402
    408403
    … …  
    447442    allocate(q2_prof_cas(nlev_cas))
    448443
    449     PRINT*,'Allocations OK'
    450     CALL old_read_SCM (nid,nlev_cas,nt_cas,                                                                    &
    451          ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
    452          ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas,        &
    453          dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,              &
    454          dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
    455          uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
    456          o3_cas,rugos_cas,clay_cas,sand_cas)
    457     PRINT*,'Read2 cas OK'
    458     do ii=1,nlev_cas
    459        PRINT*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
     444    PRINT*, 'Allocations OK'
     445    CALL old_read_SCM (nid, nlev_cas, nt_cas, &
     446            ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, &
     447            ql_cas, qi_cas, rh_cas, rv_cas, u_cas, v_cas, vitw_cas, omega_cas, ug_cas, vg_cas, du_cas, hu_cas, vu_cas, &
     448            dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, &
     449            dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, ps_cas, ustar_cas, tke_cas, &
     450            uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, &
     451            o3_cas, rugos_cas, clay_cas, sand_cas)
     452    PRINT*, 'Read2 cas OK'
     453    DO ii = 1, nlev_cas
     454      PRINT*, 'apres read2_cas, plev_cas=', ii, plev_cas(ii, 1)
    460455    enddo
    461456
    462 
    463457  END SUBROUTINE old_read_SCM_cas
    464458
    465459
    466 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     460  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    467461  SUBROUTINE deallocate2_1D_cases
    468462    !profils environnementaux:
    469     deallocate(plev_cas,plevh_cas)
    470 
    471     deallocate(z_cas,zh_cas)
    472     deallocate(ap_cas,bp_cas)
    473     deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
    474     deallocate(th_cas,thl_cas,thv_cas,rv_cas)
    475     deallocate(u_cas,v_cas,vitw_cas,omega_cas)
     463    deallocate(plev_cas, plevh_cas)
     464
     465    deallocate(z_cas, zh_cas)
     466    deallocate(ap_cas, bp_cas)
     467    deallocate(t_cas, q_cas, qv_cas, ql_cas, qi_cas, rh_cas)
     468    deallocate(th_cas, thl_cas, thv_cas, rv_cas)
     469    deallocate(u_cas, v_cas, vitw_cas, omega_cas)
    476470
    477471    !forcing
    478     deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    479     deallocate(hq_cas,vq_cas,dq_cas)
    480     deallocate(hth_cas,vth_cas,dth_cas)
    481     deallocate(hr_cas,vr_cas,dr_cas)
    482     deallocate(hu_cas,vu_cas,du_cas)
    483     deallocate(hv_cas,vv_cas,dv_cas)
     472    deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas)
     473    deallocate(hq_cas, vq_cas, dq_cas)
     474    deallocate(hth_cas, vth_cas, dth_cas)
     475    deallocate(hr_cas, vr_cas, dr_cas)
     476    deallocate(hu_cas, vu_cas, du_cas)
     477    deallocate(hv_cas, vv_cas, dv_cas)
    484478    deallocate(ug_cas)
    485479    deallocate(vg_cas)
    486     deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
     480    deallocate(lat_cas, sens_cas, ts_cas, ps_cas, ustar_cas, tke_cas, uw_cas, vw_cas, q1_cas, q2_cas)
    487481
    488482    !champs interpoles
    … …  
    528522
    529523
    530 !=====================================================================
    531 SUBROUTINE read_cas2(nid,nlevel,ntime                          &
    532      ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
    533      du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
    534      dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
    535 
    536   !program reading forcing of the case study
    537   IMPLICIT NONE
    538 
    539   INTEGER ntime,nlevel
    540 
    541   REAL zz(nlevel,ntime)
    542   REAL pp(nlevel,ntime)
    543   REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
    544   REAL theta(nlevel,ntime),rv(nlevel,ntime)
    545   REAL u(nlevel,ntime)
    546   REAL v(nlevel,ntime)
    547   REAL ug(nlevel,ntime)
    548   REAL vg(nlevel,ntime)
    549   REAL w(nlevel,ntime)
    550   REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    551   REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    552   REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    553   REAL dtrad(nlevel,ntime)
    554   REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    555   REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
    556   REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    557   REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
    558   REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
    559 
    560 
    561   INTEGER nid, ierr, ierr1,ierr2,rid,i
    562   INTEGER nbvar3d
    563   parameter(nbvar3d=39)
    564   INTEGER var3didin(nbvar3d)
    565   CHARACTER*5 name_var(1:nbvar3d)
    566   data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
    567        'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
    568        'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/
    569 
    570 
    571   do i=1,nbvar3d
    572      print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
    573   enddo
    574   do i=1,nbvar3d
    575      ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
    576      print *,'ierr=',i,ierr,name_var(i),var3didin(i)
    577      IF(ierr/=nf90_noerr) THEN
    578         print *,'Variable manquante dans cas.nc:',name_var(i)
    579      endif
    580   enddo
    581   do i=1,nbvar3d
    582      print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
    583      IF(i<=35) THEN
    584         ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    585         print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
     524  !=====================================================================
     525  SUBROUTINE read_cas2(nid, nlevel, ntime                          &
     526          , zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, &
     527          du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, &
     528          dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2)
     529
     530    !program reading forcing of the case study
     531    IMPLICIT NONE
     532
     533    INTEGER ntime, nlevel
     534
     535    REAL zz(nlevel, ntime)
     536    REAL pp(nlevel, ntime)
     537    REAL temp(nlevel, ntime), qv(nlevel, ntime), rh(nlevel, ntime)
     538    REAL theta(nlevel, ntime), rv(nlevel, ntime)
     539    REAL u(nlevel, ntime)
     540    REAL v(nlevel, ntime)
     541    REAL ug(nlevel, ntime)
     542    REAL vg(nlevel, ntime)
     543    REAL w(nlevel, ntime)
     544    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
     545    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
     546    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
     547    REAL dtrad(nlevel, ntime)
     548    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
     549    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime)
     550    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
     551    REAL flat(ntime), sens(ntime), ts(ntime), ustar(ntime)
     552    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime), resul(nlevel, ntime), resul1(ntime)
     553
     554    INTEGER nid, ierr, ierr1, ierr2, rid, i
     555    INTEGER nbvar3d
     556    parameter(nbvar3d = 39)
     557    INTEGER var3didin(nbvar3d)
     558    CHARACTER*5 name_var(1:nbvar3d)
     559    data name_var/'zz', 'pp', 'temp', 'qv', 'rh', 'theta', 'rv', 'u', 'v', 'ug', 'vg', 'w', 'advu', 'hu', 'vu', &
     560            'advv', 'hv', 'vv', 'advT', 'hT', 'vT', 'advq', 'hq', 'vq', 'advth', 'hth', 'vth', 'advr', 'hr', 'vr', &
     561            'radT', 'uw', 'vw', 'q1', 'q2', 'sens', 'flat', 'ts', 'ustar'/
     562
     563    DO i = 1, nbvar3d
     564      print *, 'Dans read_cas2, on va lire ', nid, i, name_var(i)
     565    enddo
     566    DO i = 1, nbvar3d
     567      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
     568      print *, 'ierr=', i, ierr, name_var(i), var3didin(i)
     569      IF(ierr/=nf90_noerr) THEN
     570        print *, 'Variable manquante dans cas.nc:', name_var(i)
     571      endif
     572    enddo
     573    DO i = 1, nbvar3d
     574      print *, 'Dans read_cas2, on va lire ', var3didin(i), name_var(i)
     575      IF(i<=35) THEN
     576        ierr = nf90_get_var(nid, var3didin(i), resul, count = [1, 1, nlevel, ntime])
     577        print *, 'Dans read_cas2, on a lu ', ierr, var3didin(i), name_var(i)
    586578        IF(ierr/=nf90_noerr) THEN
    587            print *,'Pb a la lecture de cas.nc: ',name_var(i)
    588            stop "getvarup"
     579          print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     580          stop "getvarup"
    589581        endif
    590      else
    591         print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    592         ierr = nf90_get_var(nid,var3didin(i),resul1, count = [1, 1, ntime])
     582      else
     583        print *, 'Dans read_cas2, on a lu ', ierr, var3didin(i), name_var(i)
     584        ierr = nf90_get_var(nid, var3didin(i), resul1, count = [1, 1, ntime])
    593585        IF(ierr/=nf90_noerr) THEN
    594            print *,'Pb a la lecture de cas.nc: ',name_var(i)
    595            stop "getvarup"
     586          print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     587          stop "getvarup"
    596588        endif
    597      endif
    598      select case(i)
    599      case(1) ; zz=resul
    600      case(2) ; pp=resul
    601      case(3) ; temp=resul
    602      case(4) ; qv=resul
    603      case(5) ; rh=resul
    604      case(6) ; theta=resul
    605      case(7) ; rv=resul
    606      case(8) ; u=resul
    607      case(9) ; v=resul
    608      case(10) ; ug=resul
    609      case(11) ; vg=resul
    610      case(12) ; w=resul
    611      case(13) ; du=resul
    612      case(14) ; hu=resul
    613      case(15) ; vu=resul
    614      case(16) ; dv=resul
    615      case(17) ; hv=resul
    616      case(18) ; vv=resul
    617      case(19) ; dt=resul
    618      case(20) ; ht=resul
    619      case(21) ; vt=resul
    620      case(22) ; dq=resul
    621      case(23) ; hq=resul
    622      case(24) ; vq=resul
    623      case(25) ; dth=resul
    624      case(26) ; hth=resul
    625      case(27) ; vth=resul
    626      case(28) ; dr=resul
    627      case(29) ; hr=resul
    628      case(30) ; vr=resul
    629      case(31) ; dtrad=resul
    630      case(32) ; uw=resul
    631      case(33) ; vw=resul
    632      case(34) ; q1=resul
    633      case(35) ; q2=resul
    634      case(36) ; sens=resul1
    635      case(37) ; flat=resul1
    636      case(38) ; ts=resul1
    637      case(39) ; ustar=resul1
    638      end select
    639   enddo
    640 
    641 
    642 END SUBROUTINE  read_cas2
    643 !======================================================================
    644 SUBROUTINE read2_cas(nid,nlevel,ntime,                                       &
    645      ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
    646      du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    647      dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
    648      orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    649      heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    650 
    651   !program reading forcing of the case study
    652   IMPLICIT NONE
    653 
    654   INTEGER ntime,nlevel
    655 
    656   REAL ap(nlevel+1),bp(nlevel+1)
    657   REAL zz(nlevel,ntime),zzh(nlevel+1)
    658   REAL pp(nlevel,ntime),pph(nlevel+1)
    659   REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    660   REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    661   REAL u(nlevel,ntime),v(nlevel,ntime)
    662   REAL ug(nlevel,ntime),vg(nlevel,ntime)
    663   REAL vitw(nlevel,ntime),omega(nlevel,ntime)
    664   REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    665   REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    666   REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    667   REAL dtrad(nlevel,ntime)
    668   REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    669   REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    670   REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    671   REAL flat(ntime),sens(ntime),ustar(ntime)
    672   REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    673   REAL ts(ntime),ps(ntime),tke(ntime)
    674   REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
    675   REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    676 
    677 
    678   INTEGER nid, ierr,ierr1,ierr2,rid,i
    679   INTEGER nbvar3d
    680   parameter(nbvar3d=62)
    681   INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    682   CHARACTER*12 name_var(1:nbvar3d)
    683   data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    684        'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    685        'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
    686        'rh',&
    687        'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
    688        'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
    689        'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
    690   do i=1,nbvar3d
    691      missing_var(i)=0.
    692   enddo
    693 
    694   !-----------------------------------------------------------------------
    695   do i=1,nbvar3d
    696      ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
    697      IF(ierr/=nf90_noerr) THEN
    698         print *,'Variable manquante dans cas.nc:',i,name_var(i)
    699         ierr=nf90_noerr
    700         missing_var(i)=1
    701      else
     589      endif
     590      select case(i)
     591      case(1) ; zz = resul
     592      case(2) ; pp = resul
     593      case(3) ; temp = resul
     594      case(4) ; qv = resul
     595      case(5) ; rh = resul
     596      case(6) ; theta = resul
     597      case(7) ; rv = resul
     598      case(8) ; u = resul
     599      case(9) ; v = resul
     600      case(10) ; ug = resul
     601      case(11) ; vg = resul
     602      case(12) ; w = resul
     603      case(13) ; du = resul
     604      case(14) ; hu = resul
     605      case(15) ; vu = resul
     606      case(16) ; dv = resul
     607      case(17) ; hv = resul
     608      case(18) ; vv = resul
     609      case(19) ; dt = resul
     610      case(20) ; ht = resul
     611      case(21) ; vt = resul
     612      case(22) ; dq = resul
     613      case(23) ; hq = resul
     614      case(24) ; vq = resul
     615      case(25) ; dth = resul
     616      case(26) ; hth = resul
     617      case(27) ; vth = resul
     618      case(28) ; dr = resul
     619      case(29) ; hr = resul
     620      case(30) ; vr = resul
     621      case(31) ; dtrad = resul
     622      case(32) ; uw = resul
     623      case(33) ; vw = resul
     624      case(34) ; q1 = resul
     625      case(35) ; q2 = resul
     626      case(36) ; sens = resul1
     627      case(37) ; flat = resul1
     628      case(38) ; ts = resul1
     629      case(39) ; ustar = resul1
     630      end select
     631    enddo
     632
     633  END SUBROUTINE  read_cas2
     634  !======================================================================
     635  SUBROUTINE read2_cas(nid, nlevel, ntime, &
     636          ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, ug, vg, &
     637          du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, &
     638          dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, ps, ustar, tke, uw, vw, q1, q2, &
     639          orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, &
     640          heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas)
     641
     642    !program reading forcing of the case study
     643    IMPLICIT NONE
     644
     645    INTEGER ntime, nlevel
     646
     647    REAL ap(nlevel + 1), bp(nlevel + 1)
     648    REAL zz(nlevel, ntime), zzh(nlevel + 1)
     649    REAL pp(nlevel, ntime), pph(nlevel + 1)
     650    REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime)
     651    REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime)
     652    REAL u(nlevel, ntime), v(nlevel, ntime)
     653    REAL ug(nlevel, ntime), vg(nlevel, ntime)
     654    REAL vitw(nlevel, ntime), omega(nlevel, ntime)
     655    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
     656    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
     657    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
     658    REAL dtrad(nlevel, ntime)
     659    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
     660    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime)
     661    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
     662    REAL flat(ntime), sens(ntime), ustar(ntime)
     663    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
     664    REAL ts(ntime), ps(ntime), tke(ntime)
     665    REAL orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas
     666    REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3
     667
     668    INTEGER nid, ierr, ierr1, ierr2, rid, i
     669    INTEGER nbvar3d
     670    parameter(nbvar3d = 62)
     671    INTEGER var3didin(nbvar3d), missing_var(nbvar3d)
     672    CHARACTER*12 name_var(1:nbvar3d)
     673    data name_var/'coor_par_a', 'coor_par_b', 'height_h', 'pressure_h', &
     674            'w', 'omega', 'ug', 'vg', 'uadv', 'uadvh', 'uadvv', 'vadv', 'vadvh', 'vadvv', 'tadv', 'tadvh', 'tadvv', &
     675            'qadv', 'qadvh', 'qadvv', 'thadv', 'thadvh', 'thadvv', 'thladvh', 'radv', 'radvh', 'radvv', 'radcool', 'q1', 'q2', 'ustress', 'vstress', &
     676            'rh', &
     677            'height_f', 'pressure_f', 'temp', 'theta', 'thv', 'thl', 'qv', 'ql', 'qi', 'rv', 'u', 'v', &
     678            'sfc_sens_flx', 'sfc_lat_flx', 'ts', 'ps', 'ustar', 'tke', &
     679            'orog', 'albedo', 'emiss', 't_skin', 'q_skin', 'mom_rough', 'heat_rough', 'o3', 'rugos', 'clay', 'sand'/
     680    DO i = 1, nbvar3d
     681      missing_var(i) = 0.
     682    enddo
     683
     684    !-----------------------------------------------------------------------
     685    DO i = 1, nbvar3d
     686      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
     687      IF(ierr/=nf90_noerr) THEN
     688        print *, 'Variable manquante dans cas.nc:', i, name_var(i)
     689        ierr = nf90_noerr
     690        missing_var(i) = 1
     691      else
    702692        !-----------------------------------------------------------------------
    703693        IF(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    704            ierr = nf90_get_var(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
    705            print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    706            IF(ierr/=nf90_noerr) THEN
    707               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    708               stop "getvarup"
    709            endif
    710            !-----------------------------------------------------------------------
     694          ierr = nf90_get_var(nid, var3didin(i), apbp, count = [1, 1, nlevel + 1])
     695          print *, 'read2_cas(apbp), on a lu ', i, name_var(i)
     696          IF(ierr/=nf90_noerr) THEN
     697            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     698            stop "getvarup"
     699          endif
     700          !-----------------------------------------------------------------------
    711701        else IF(i>4.AND.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
    712            ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    713            print *,'read2_cas(resul), on a lu ',i,name_var(i)
    714            IF(ierr/=nf90_noerr) THEN
    715               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    716               stop "getvarup"
    717            endif
    718            !-----------------------------------------------------------------------
     702          ierr = nf90_get_var(nid, var3didin(i), resul, count = [1, 1, nlevel, ntime])
     703          print *, 'read2_cas(resul), on a lu ', i, name_var(i)
     704          IF(ierr/=nf90_noerr) THEN
     705            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     706            stop "getvarup"
     707          endif
     708          !-----------------------------------------------------------------------
    719709        ELSE IF (i>45.AND.i<=51) then   ! Lecture des variables en (time,lat,lon)
    720            ierr = nf90_get_var(nid,var3didin(i),resul2, count = [1, 1, ntime])
    721            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    722            IF(ierr/=nf90_noerr) THEN
    723               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    724               stop "getvarup"
    725            endif
    726            !-----------------------------------------------------------------------
     710          ierr = nf90_get_var(nid, var3didin(i), resul2, count = [1, 1, ntime])
     711          print *, 'read2_cas(resul2), on a lu ', i, name_var(i)
     712          IF(ierr/=nf90_noerr) THEN
     713            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     714            stop "getvarup"
     715          endif
     716          !-----------------------------------------------------------------------
    727717        else     ! Lecture des constantes (lat,lon)
    728            ierr = nf90_get_var(nid,var3didin(i),resul3)
    729            print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    730            IF(ierr/=nf90_noerr) THEN
    731               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    732               stop "getvarup"
    733            endif
     718          ierr = nf90_get_var(nid, var3didin(i), resul3)
     719          print *, 'read2_cas(resul3), on a lu ', i, name_var(i)
     720          IF(ierr/=nf90_noerr) THEN
     721            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     722            stop "getvarup"
     723          endif
    734724        endif
    735      endif
    736      !-----------------------------------------------------------------------
    737      select case(i)
    738      case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    739      case(2) ; bp=apbp
    740      case(3) ; zzh=apbp
    741      case(4) ; pph=apbp
    742      case(5) ; vitw=resul    ! donnees indexees en nlevel,time
    743      case(6) ; omega=resul
    744      case(7) ; ug=resul
    745      case(8) ; vg=resul
    746      case(9) ; du=resul
    747      case(10) ; hu=resul
    748      case(11) ; vu=resul
    749      case(12) ; dv=resul
    750      case(13) ; hv=resul
    751      case(14) ; vv=resul
    752      case(15) ; dt=resul
    753      case(16) ; ht=resul
    754      case(17) ; vt=resul
    755      case(18) ; dq=resul
    756      case(19) ; hq=resul
    757      case(20) ; vq=resul
    758      case(21) ; dth=resul
    759      case(22) ; hth=resul
    760      case(23) ; vth=resul
    761      case(24) ; hthl=resul
    762      case(25) ; dr=resul
    763      case(26) ; hr=resul
    764      case(27) ; vr=resul
    765      case(28) ; dtrad=resul
    766      case(29) ; q1=resul
    767      case(30) ; q2=resul
    768      case(31) ; uw=resul
    769      case(32) ; vw=resul
    770      case(33) ; rh=resul
    771      case(34) ; zz=resul      ! donnees en time,nlevel pour profil initial
    772      case(35) ; pp=resul
    773      case(36) ; temp=resul
    774      case(37) ; theta=resul
    775      case(38) ; thv=resul
    776      case(39) ; thl=resul
    777      case(40) ; qv=resul
    778      case(41) ; ql=resul
    779      case(42) ; qi=resul
    780      case(43) ; rv=resul
    781      case(44) ; u=resul
    782      case(45) ; v=resul
    783      case(46) ; sens=resul2   ! donnees indexees en time
    784      case(47) ; flat=resul2
    785      case(48) ; ts=resul2
    786      case(49) ; ps=resul2
    787      case(50) ; ustar=resul2
    788      case(51) ; tke=resul2
    789      case(52) ; orog_cas=resul3      ! constantes
    790      case(53) ; albedo_cas=resul3
    791      case(54) ; emiss_cas=resul3
    792      case(55) ; t_skin_cas=resul3
    793      case(56) ; q_skin_cas=resul3
    794      case(57) ; mom_rough=resul3
    795      case(58) ; heat_rough=resul3
    796      case(59) ; o3_cas=resul3       
    797      case(60) ; rugos_cas=resul3
    798      case(61) ; clay_cas=resul3
    799      case(62) ; sand_cas=resul3
    800      end select
    801      resul=0.
    802      resul1=0.
    803      resul2=0.
    804      resul3=0.
    805   enddo
    806   !-----------------------------------------------------------------------
    807 
    808 
    809 
    810 END SUBROUTINE  read2_cas
    811 
    812 !======================================================================
    813 SUBROUTINE old_read_SCM(nid,nlevel,ntime,                                       &
    814      ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
    815      du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    816      dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
    817      orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    818      heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    819 
    820   !program reading forcing of the case study
    821   IMPLICIT NONE
    822 
    823   INTEGER ntime,nlevel,k,t
    824 
    825   REAL ap(nlevel+1),bp(nlevel+1)
    826   REAL zz(nlevel,ntime),zzh(nlevel+1)
    827   REAL pp(nlevel,ntime),pph(nlevel+1)
    828   !profils initiaux
    829   REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
    830   REAL pp0(nlevel)
    831   REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    832   REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    833   REAL u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
    834   REAL ug(nlevel,ntime),vg(nlevel,ntime)
    835   REAL vitw(nlevel,ntime),omega(nlevel,ntime)
    836   REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    837   REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    838   REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    839   REAL dtrad(nlevel,ntime)
    840   REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    841   REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    842   REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    843   REAL flat(ntime),sens(ntime),ustar(ntime)
    844   REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    845   REAL ts(ntime),ps(ntime)
    846   REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
    847   REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    848 
    849 
    850   INTEGER nid, ierr,ierr1,ierr2,rid,i
    851   INTEGER nbvar3d
    852   parameter(nbvar3d=70)
    853   INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    854   CHARACTER*13 name_var(1:nbvar3d)
    855   data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    856        'temp','qv','ql','qi','u','v','tke','pressure',&
    857        'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    858        'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress', &
    859        'vstress','rh',&
    860        'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
    861        'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
    862        'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
    863   do i=1,nbvar3d
    864      missing_var(i)=0.
    865   enddo
    866 
    867   !-----------------------------------------------------------------------
    868 
    869   PRINT*,'ON EST LA'
    870   do i=1,nbvar3d
    871      ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
    872      IF(ierr/=nf90_noerr) THEN
    873         print *,'Variable manquante dans cas.nc:',i,name_var(i)
    874         ierr=nf90_noerr
    875         missing_var(i)=1
    876      else
     725      endif
     726      !-----------------------------------------------------------------------
     727      select case(i)
     728      case(1) ; ap = apbp       ! donnees indexees en nlevel+1
     729      case(2) ; bp = apbp
     730      case(3) ; zzh = apbp
     731      case(4) ; pph = apbp
     732      case(5) ; vitw = resul    ! donnees indexees en nlevel,time
     733      case(6) ; omega = resul
     734      case(7) ; ug = resul
     735      case(8) ; vg = resul
     736      case(9) ; du = resul
     737      case(10) ; hu = resul
     738      case(11) ; vu = resul
     739      case(12) ; dv = resul
     740      case(13) ; hv = resul
     741      case(14) ; vv = resul
     742      case(15) ; dt = resul
     743      case(16) ; ht = resul
     744      case(17) ; vt = resul
     745      case(18) ; dq = resul
     746      case(19) ; hq = resul
     747      case(20) ; vq = resul
     748      case(21) ; dth = resul
     749      case(22) ; hth = resul
     750      case(23) ; vth = resul
     751      case(24) ; hthl = resul
     752      case(25) ; dr = resul
     753      case(26) ; hr = resul
     754      case(27) ; vr = resul
     755      case(28) ; dtrad = resul
     756      case(29) ; q1 = resul
     757      case(30) ; q2 = resul
     758      case(31) ; uw = resul
     759      case(32) ; vw = resul
     760      case(33) ; rh = resul
     761      case(34) ; zz = resul      ! donnees en time,nlevel pour profil initial
     762      case(35) ; pp = resul
     763      case(36) ; temp = resul
     764      case(37) ; theta = resul
     765      case(38) ; thv = resul
     766      case(39) ; thl = resul
     767      case(40) ; qv = resul
     768      case(41) ; ql = resul
     769      case(42) ; qi = resul
     770      case(43) ; rv = resul
     771      case(44) ; u = resul
     772      case(45) ; v = resul
     773      case(46) ; sens = resul2   ! donnees indexees en time
     774      case(47) ; flat = resul2
     775      case(48) ; ts = resul2
     776      case(49) ; ps = resul2
     777      case(50) ; ustar = resul2
     778      case(51) ; tke = resul2
     779      case(52) ; orog_cas = resul3      ! constantes
     780      case(53) ; albedo_cas = resul3
     781      case(54) ; emiss_cas = resul3
     782      case(55) ; t_skin_cas = resul3
     783      case(56) ; q_skin_cas = resul3
     784      case(57) ; mom_rough = resul3
     785      case(58) ; heat_rough = resul3
     786      case(59) ; o3_cas = resul3
     787      case(60) ; rugos_cas = resul3
     788      case(61) ; clay_cas = resul3
     789      case(62) ; sand_cas = resul3
     790      end select
     791      resul = 0.
     792      resul1 = 0.
     793      resul2 = 0.
     794      resul3 = 0.
     795    enddo
     796    !-----------------------------------------------------------------------
     797
     798  END SUBROUTINE  read2_cas
     799
     800  !======================================================================
     801  SUBROUTINE old_read_SCM(nid, nlevel, ntime, &
     802          ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, ug, vg, &
     803          du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, &
     804          dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, ps, ustar, tke, uw, vw, q1, q2, &
     805          orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, &
     806          heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas)
     807
     808    !program reading forcing of the case study
     809    IMPLICIT NONE
     810
     811    INTEGER ntime, nlevel, k, t
     812
     813    REAL ap(nlevel + 1), bp(nlevel + 1)
     814    REAL zz(nlevel, ntime), zzh(nlevel + 1)
     815    REAL pp(nlevel, ntime), pph(nlevel + 1)
     816    !profils initiaux
     817    REAL temp0(nlevel), qv0(nlevel), ql0(nlevel), qi0(nlevel), u0(nlevel), v0(nlevel), tke0(nlevel)
     818    REAL pp0(nlevel)
     819    REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime)
     820    REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime)
     821    REAL u(nlevel, ntime), v(nlevel, ntime), tke(nlevel, ntime)
     822    REAL ug(nlevel, ntime), vg(nlevel, ntime)
     823    REAL vitw(nlevel, ntime), omega(nlevel, ntime)
     824    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
     825    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
     826    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
     827    REAL dtrad(nlevel, ntime)
     828    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
     829    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime)
     830    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
     831    REAL flat(ntime), sens(ntime), ustar(ntime)
     832    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
     833    REAL ts(ntime), ps(ntime)
     834    REAL orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas
     835    REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3
     836
     837    INTEGER nid, ierr, ierr1, ierr2, rid, i
     838    INTEGER nbvar3d
     839    parameter(nbvar3d = 70)
     840    INTEGER var3didin(nbvar3d), missing_var(nbvar3d)
     841    CHARACTER*13 name_var(1:nbvar3d)
     842    data name_var/'coor_par_a', 'coor_par_b', 'height_h', 'pressure_h', &
     843            'temp', 'qv', 'ql', 'qi', 'u', 'v', 'tke', 'pressure', &
     844            'w', 'omega', 'ug', 'vg', 'uadv', 'uadvh', 'uadvv', 'vadv', 'vadvh', 'vadvv', 'tadv', 'tadvh', 'tadvv', &
     845            'qvadv', 'qvadvh', 'qvadvv', 'thadv', 'thadvh', 'thadvv', 'thladvh', 'radv', 'radvh', 'radvv', 'radcool', 'q1', 'q2', 'ustress', &
     846            'vstress', 'rh', &
     847            'height_f', 'pressure_forc', 'tempt', 'theta', 'thv', 'thl', 'qvt', 'qlt', 'qit', 'rv', 'ut', 'vt', 'tket', &
     848            'sfc_sens_flx', 'sfc_lat_flx', 'ts', 'ps', 'ustar', &
     849            'orog', 'albedo', 'emiss', 't_skin', 'q_skin', 'mom_rough', 'heat_rough', 'o3', 'rugos', 'clay', 'sand'/
     850    DO i = 1, nbvar3d
     851      missing_var(i) = 0.
     852    enddo
     853
     854    !-----------------------------------------------------------------------
     855
     856    PRINT*, 'ON EST LA'
     857    DO i = 1, nbvar3d
     858      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
     859      IF(ierr/=nf90_noerr) THEN
     860        print *, 'Variable manquante dans cas.nc:', i, name_var(i)
     861        ierr = nf90_noerr
     862        missing_var(i) = 1
     863      else
    877864        !-----------------------------------------------------------------------
    878865        IF(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    879            ierr = nf90_get_var(nid,var3didin(i),apbp)
    880            print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    881            IF(ierr/=nf90_noerr) THEN
    882               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    883               stop "getvarup"
    884            endif
    885            !-----------------------------------------------------------------------
     866          ierr = nf90_get_var(nid, var3didin(i), apbp)
     867          print *, 'read2_cas(apbp), on a lu ', i, name_var(i)
     868          IF(ierr/=nf90_noerr) THEN
     869            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     870            stop "getvarup"
     871          endif
     872          !-----------------------------------------------------------------------
    886873        else IF(i>4.AND.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
    887            ierr = nf90_get_var(nid,var3didin(i),resul1)
    888            print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    889            IF(ierr/=nf90_noerr) THEN
    890               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    891               stop "getvarup"
    892            endif
    893            PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    894            !-----------------------------------------------------------------------
     874          ierr = nf90_get_var(nid, var3didin(i), resul1)
     875          print *, 'read2_cas(resul1), on a lu ', i, name_var(i)
     876          IF(ierr/=nf90_noerr) THEN
     877            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     878            stop "getvarup"
     879          endif
     880          PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul1), maxval(resul1)
     881          !-----------------------------------------------------------------------
    895882        else IF(i>12.AND.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
    896            ierr = nf90_get_var(nid,var3didin(i),resul)
    897            print *,'read2_cas(resul), on a lu ',i,name_var(i)
    898            IF(ierr/=nf90_noerr) THEN
    899               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    900               stop "getvarup"
    901            endif
    902            PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    903            !-----------------------------------------------------------------------
     883          ierr = nf90_get_var(nid, var3didin(i), resul)
     884          print *, 'read2_cas(resul), on a lu ', i, name_var(i)
     885          IF(ierr/=nf90_noerr) THEN
     886            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     887            stop "getvarup"
     888          endif
     889          PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul), maxval(resul)
     890          !-----------------------------------------------------------------------
    904891        ELSE IF (i>54.AND.i<=65) then   ! Lecture des variables en (time,lat,lon)
    905            ierr = nf90_get_var(nid,var3didin(i),resul2)
    906            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    907            IF(ierr/=nf90_noerr) THEN
    908               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    909               stop "getvarup"
    910            endif
    911            PRINT*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
    912            !-----------------------------------------------------------------------
     892          ierr = nf90_get_var(nid, var3didin(i), resul2)
     893          print *, 'read2_cas(resul2), on a lu ', i, name_var(i)
     894          IF(ierr/=nf90_noerr) THEN
     895            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     896            stop "getvarup"
     897          endif
     898          PRINT*, 'Lecture de la variable #i  ', i, name_var(i), minval(resul2), maxval(resul2)
     899          !-----------------------------------------------------------------------
    913900        else     ! Lecture des constantes (lat,lon)
    914            ierr = nf90_get_var(nid,var3didin(i),resul3)
    915            print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    916            IF(ierr/=nf90_noerr) THEN
    917               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    918               stop "getvarup"
    919            endif
    920            PRINT*,'Lecture de la variable #i ',i,name_var(i),resul3
     901          ierr = nf90_get_var(nid, var3didin(i), resul3)
     902          print *, 'read2_cas(resul3), on a lu ', i, name_var(i)
     903          IF(ierr/=nf90_noerr) THEN
     904            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
     905            stop "getvarup"
     906          endif
     907          PRINT*, 'Lecture de la variable #i ', i, name_var(i), resul3
    921908        endif
    922      endif
    923      !-----------------------------------------------------------------------
    924      select case(i)
     909      endif
     910      !-----------------------------------------------------------------------
     911      select case(i)
    925912        !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    926913        ! case(2) ; bp=apbp
    927      case(3) ; zzh=apbp
    928      case(4) ; pph=apbp
    929      case(5) ; temp0=resul1    ! donnees initiales
    930      case(6) ; qv0=resul1
    931      case(7) ; ql0=resul1
    932      case(8) ; qi0=resul1
    933      case(9) ; u0=resul1
    934      case(10) ; v0=resul1
    935      case(11) ; tke0=resul1
    936      case(12) ; pp0=resul1
    937      case(13) ; vitw=resul    ! donnees indexees en nlevel,time
    938      case(14) ; omega=resul
    939      case(15) ; ug=resul
    940      case(16) ; vg=resul
    941      case(17) ; du=resul
    942      case(18) ; hu=resul
    943      case(19) ; vu=resul
    944      case(20) ; dv=resul
    945      case(21) ; hv=resul
    946      case(22) ; vv=resul
    947      case(23) ; dt=resul
    948      case(24) ; ht=resul
    949      case(25) ; vt=resul
    950      case(26) ; dq=resul
    951      case(27) ; hq=resul
    952      case(28) ; vq=resul
    953      case(29) ; dth=resul
    954      case(30) ; hth=resul
    955      case(31) ; vth=resul
    956      case(32) ; hthl=resul
    957      case(33) ; dr=resul
    958      case(34) ; hr=resul
    959      case(35) ; vr=resul
    960      case(36) ; dtrad=resul
    961      case(37) ; q1=resul
    962      case(38) ; q2=resul
    963      case(39) ; uw=resul
    964      case(40) ; vw=resul
    965      case(41) ; rh=resul
    966      case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
    967      case(43) ; pp=resul
    968      case(44) ; temp=resul
    969      case(45) ; theta=resul
    970      case(46) ; thv=resul
    971      case(47) ; thl=resul
    972      case(48) ; qv=resul
    973      case(49) ; ql=resul
    974      case(50) ; qi=resul
    975      case(51) ; rv=resul
    976      case(52) ; u=resul
    977      case(53) ; v=resul
    978      case(54) ; tke=resul
    979      case(55) ; sens=resul2   ! donnees indexees en time
    980      case(56) ; flat=resul2
    981      case(57) ; ts=resul2
    982      case(58) ; ps=resul2
    983      case(59) ; ustar=resul2
    984      case(60) ; orog_cas=resul3      ! constantes
    985      case(61) ; albedo_cas=resul3
    986      case(62) ; emiss_cas=resul3
    987      case(63) ; t_skin_cas=resul3
    988      case(64) ; q_skin_cas=resul3
    989      case(65) ; mom_rough=resul3
    990      case(66) ; heat_rough=resul3
    991      case(67) ; o3_cas=resul3       
    992      case(68) ; rugos_cas=resul3
    993      case(69) ; clay_cas=resul3
    994      case(70) ; sand_cas=resul3
    995      end select
    996      resul=0.
    997      resul1=0.
    998      resul2=0.
    999      resul3=0.
    1000   enddo
    1001   PRINT*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
    1002   PRINT*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
    1003 
    1004   !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
    1005   do t=1,ntime
    1006      do k=1,nlevel
    1007         temp(k,t)=temp0(k)
    1008         qv(k,t)=qv0(k)
    1009         ql(k,t)=ql0(k)
    1010         qi(k,t)=qi0(k)
    1011         u(k,t)=u0(k)
    1012         v(k,t)=v0(k)
    1013         tke(k,t)=tke0(k)
    1014      enddo
    1015   enddo
    1016   !-----------------------------------------------------------------------
    1017 
    1018 
    1019 END SUBROUTINE  old_read_SCM
    1020 !======================================================================
    1021 
    1022 !======================================================================
    1023 SUBROUTINE interp_case_time2(day,day1,annee_ref                &
    1024      !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
    1025      ,nt_cas,nlev_cas                                       &
    1026      ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
    1027      ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
    1028      ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
    1029      ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
    1030      ,uw_cas,vw_cas,q1_cas,q2_cas                           &
    1031      ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
    1032      ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
    1033      ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
    1034      ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
    1035      ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
    1036      ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
    1037      ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
    1038 
    1039 
    1040   IMPLICIT NONE
    1041 
    1042   !---------------------------------------------------------------------------------------
    1043   ! Time interpolation of a 2D field to the timestep corresponding to day
    1044 
    1045   ! day: current julian day (e.g. 717538.2)
    1046   ! day1: first day of the simulation
    1047   ! nt_cas: total nb of data in the forcing
    1048   ! pdt_cas: total time interval (in sec) between 2 forcing data
    1049   !---------------------------------------------------------------------------------------
    1050 
    1051   INCLUDE "compar1d.h"
    1052   INCLUDE "date_cas.h"
    1053 
    1054   ! inputs:
    1055   INTEGER annee_ref
    1056   INTEGER nt_cas,nlev_cas
    1057   REAL day, day1,day_cas
    1058   REAL ts_cas(nt_cas),ps_cas(nt_cas)
    1059   REAL plev_cas(nlev_cas,nt_cas)
    1060   REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
    1061   REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1062   REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1063   REAL vitw_cas(nlev_cas,nt_cas)
    1064   REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1065   REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1066   REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1067   REAL dtrad_cas(nlev_cas,nt_cas)
    1068   REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1069   REAL lat_cas(nt_cas)
    1070   REAL sens_cas(nt_cas)
    1071   REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1072   REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    1073 
    1074   ! outputs:
    1075   REAL plev_prof_cas(nlev_cas)
    1076   REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    1077   REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1078   REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1079   REAL vitw_prof_cas(nlev_cas)
    1080   REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1081   REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1082   REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1083   REAL dtrad_prof_cas(nlev_cas)
    1084   REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1085   REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    1086   REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    1087   ! local:
    1088   INTEGER it_cas1, it_cas2,k
    1089   REAL timeit,time_cas1,time_cas2,frac
    1090 
    1091 
    1092   PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    1093 
    1094   ! On teste si la date du cas AMMA est correcte.
    1095   ! C est pour memoire car en fait les fichiers .def
    1096   ! sont censes etre corrects.
    1097   ! A supprimer a terme (MPL 20150623)
    1098   !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    1099   ! Check that initial day of the simulation consistent with AMMA case:
    1100   !      if (annee_ref.NE.2006) THEN
    1101   !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    1102   !       PRINT*,'Changer annee_ref dans run.def'
    1103   !       stop
    1104   !      endif
    1105   !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    1106   !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    1107   !       PRINT*,'Changer dayref dans run.def'
    1108   !       stop
    1109   !      endif
    1110   !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    1111   !       PRINT*,'AMMA a fini le 11 juillet'
    1112   !       PRINT*,'Changer dayref ou nday dans run.def'
    1113   !       stop
    1114   !      endif
    1115   !      endif
    1116 
    1117   ! Determine timestep relative to the 1st day:
    1118   !       timeit=(day-day1)*86400.
    1119   !       if (annee_ref.EQ.1992) THEN
    1120   !        timeit=(day-day_cas)*86400.
    1121   !       else
    1122   !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    1123   !       endif
    1124   timeit=(day-day_ju_ini_cas)*86400
    1125   !print *,'day=',day
    1126   !print *,'day_ju_ini_cas=',day_ju_ini_cas
    1127   !print *,'pdt_cas=',pdt_cas
    1128   !print *,'timeit=',timeit
    1129   !print *,'nt_cas=',nt_cas
    1130 
    1131   ! Determine the closest observation times:
    1132   !       it_cas1=INT(timeit/pdt_cas)+1
    1133   !       it_cas2=it_cas1 + 1
    1134   !       time_cas1=(it_cas1-1)*pdt_cas
    1135   !       time_cas2=(it_cas2-1)*pdt_cas
    1136 
    1137   it_cas1=INT(timeit/pdt_cas)+1
    1138   IF (it_cas1 == nt_cas) THEN
    1139      it_cas2=it_cas1
    1140   ELSE
    1141      it_cas2=it_cas1 + 1
    1142   ENDIF
    1143   time_cas1=(it_cas1-1)*pdt_cas
    1144   time_cas2=(it_cas2-1)*pdt_cas
    1145   !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    1146 
    1147   IF (it_cas1 > nt_cas) THEN
    1148      WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    1149           ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    1150      stop
    1151   ENDIF
    1152 
    1153   ! time interpolation:
    1154   IF (it_cas1 == it_cas2) THEN
    1155      frac=0.
    1156   ELSE
    1157      frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    1158      frac=max(frac,0.0)
    1159   ENDIF
    1160 
    1161   lat_prof_cas = lat_cas(it_cas2)                                       &
    1162        -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    1163   sens_prof_cas = sens_cas(it_cas2)                                     &
    1164        -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    1165   ts_prof_cas = ts_cas(it_cas2)                                         &
    1166        -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    1167   ustar_prof_cas = ustar_cas(it_cas2)                                   &
    1168        -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    1169 
    1170   do k=1,nlev_cas
    1171      plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
    1172           -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    1173      t_prof_cas(k) = t_cas(k,it_cas2)                               &
    1174           -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    1175      q_prof_cas(k) = q_cas(k,it_cas2)                               &
    1176           -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
    1177      u_prof_cas(k) = u_cas(k,it_cas2)                               &
    1178           -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    1179      v_prof_cas(k) = v_cas(k,it_cas2)                               &
    1180           -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    1181      ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    1182           -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    1183      vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    1184           -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    1185      vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
    1186           -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    1187      du_prof_cas(k) = du_cas(k,it_cas2)                                   &
    1188           -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    1189      hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
    1190           -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    1191      vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
    1192           -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    1193      dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
    1194           -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    1195      hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
    1196           -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    1197      vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
    1198           -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    1199      dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
    1200           -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    1201      ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
    1202           -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    1203      vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
    1204           -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    1205      dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
    1206           -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    1207      dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
    1208           -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    1209      hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
    1210           -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    1211      vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
    1212           -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    1213      uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
    1214           -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    1215      vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
    1216           -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1217      q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
    1218           -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1219      q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
    1220           -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1221   enddo
    1222 
    1223 
    1224 END SUBROUTINE interp_case_time2
    1225 
    1226 !**********************************************************************************************
    1227 SUBROUTINE interp2_case_time(day,day1,annee_ref                           &
    1228      !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
    1229      ,nt_cas,nlev_cas                                                   &
    1230      ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
    1231      ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
    1232      ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
    1233      ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
    1234      ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
    1235      ,lat_cas,sens_cas,ustar_cas                                        &
    1236      ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
    1237 
    1238      ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    1239      ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    1240      ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
    1241      ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
    1242      ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
    1243      ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
    1244      ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
    1245      ,lat_prof_cas,sens_prof_cas                                        &
    1246      ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
    1247 
    1248 
    1249   IMPLICIT NONE
    1250 
    1251   !---------------------------------------------------------------------------------------
    1252   ! Time interpolation of a 2D field to the timestep corresponding to day
    1253 
    1254   ! day: current julian day (e.g. 717538.2)
    1255   ! day1: first day of the simulation
    1256   ! nt_cas: total nb of data in the forcing
    1257   ! pdt_cas: total time interval (in sec) between 2 forcing data
    1258   !---------------------------------------------------------------------------------------
    1259 
    1260   INCLUDE "compar1d.h"
    1261   INCLUDE "date_cas.h"
    1262 
    1263   ! inputs:
    1264   INTEGER annee_ref
    1265   INTEGER nt_cas,nlev_cas
    1266   REAL day, day1,day_cas
    1267   REAL ts_cas(nt_cas),ps_cas(nt_cas)
    1268   REAL plev_cas(nlev_cas,nt_cas)
    1269   REAL t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
    1270   REAL qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
    1271   REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1272   REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1273   REAL vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
    1274   REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1275   REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1276   REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1277   REAL dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
    1278   REAL dtrad_cas(nlev_cas,nt_cas)
    1279   REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1280   REAL lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
    1281   REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1282   REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    1283 
    1284   ! outputs:
    1285   REAL plev_prof_cas(nlev_cas)
    1286   REAL t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
    1287   REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    1288   REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1289   REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1290   REAL vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
    1291   REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1292   REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1293   REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1294   REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    1295   REAL dtrad_prof_cas(nlev_cas)
    1296   REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1297   REAL lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
    1298   REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    1299   ! local:
    1300   INTEGER it_cas1, it_cas2,k
    1301   REAL timeit,time_cas1,time_cas2,frac
    1302 
    1303 
    1304   PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    1305   !       do k=1,nlev_cas
    1306   !       PRINT*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
    1307   !       enddo
    1308 
    1309   ! On teste si la date du cas AMMA est correcte.
    1310   ! C est pour memoire car en fait les fichiers .def
    1311   ! sont censes etre corrects.
    1312   ! A supprimer a terme (MPL 20150623)
    1313   !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
    1314   ! Check that initial day of the simulation consistent with AMMA case:
    1315   !      if (annee_ref.NE.2006) THEN
    1316   !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
    1317   !       PRINT*,'Changer annee_ref dans run.def'
    1318   !       stop
    1319   !      endif
    1320   !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
    1321   !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    1322   !       PRINT*,'Changer dayref dans run.def'
    1323   !       stop
    1324   !      endif
    1325   !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
    1326   !       PRINT*,'AMMA a fini le 11 juillet'
    1327   !       PRINT*,'Changer dayref ou nday dans run.def'
    1328   !       stop
    1329   !      endif
    1330   !      endif
    1331 
    1332   ! Determine timestep relative to the 1st day:
    1333   !       timeit=(day-day1)*86400.
    1334   !       if (annee_ref.EQ.1992) THEN
    1335   !        timeit=(day-day_cas)*86400.
    1336   !       else
    1337   !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    1338   !       endif
    1339   timeit=(day-day_ju_ini_cas)*86400
    1340   !print *,'day=',day
    1341   !print *,'day_ju_ini_cas=',day_ju_ini_cas
    1342   !print *,'pdt_cas=',pdt_cas
    1343   !print *,'timeit=',timeit
    1344   !print *,'nt_cas=',nt_cas
    1345 
    1346   ! Determine the closest observation times:
    1347   !       it_cas1=INT(timeit/pdt_cas)+1
    1348   !       it_cas2=it_cas1 + 1
    1349   !       time_cas1=(it_cas1-1)*pdt_cas
    1350   !       time_cas2=(it_cas2-1)*pdt_cas
    1351 
    1352   it_cas1=INT(timeit/pdt_cas)+1
    1353   IF (it_cas1 == nt_cas) THEN
    1354      it_cas2=it_cas1
    1355   ELSE
    1356      it_cas2=it_cas1 + 1
    1357   ENDIF
    1358   time_cas1=(it_cas1-1)*pdt_cas
    1359   time_cas2=(it_cas2-1)*pdt_cas
    1360   !print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
    1361   !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    1362 
    1363   IF (it_cas1 > nt_cas) THEN
    1364      WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    1365           ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    1366      stop
    1367   ENDIF
    1368 
    1369   ! time interpolation:
    1370   IF (it_cas1 == it_cas2) THEN
    1371      frac=0.
    1372   ELSE
    1373      frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    1374      frac=max(frac,0.0)
    1375   ENDIF
    1376 
    1377   lat_prof_cas = lat_cas(it_cas2)                                   &
    1378        -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    1379   sens_prof_cas = sens_cas(it_cas2)                                 &
    1380        -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    1381   tke_prof_cas = tke_cas(it_cas2)                                   &
    1382        -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
    1383   ts_prof_cas = ts_cas(it_cas2)                                     &
    1384        -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    1385   ustar_prof_cas = ustar_cas(it_cas2)                               &
    1386        -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    1387 
    1388   do k=1,nlev_cas
    1389      plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
    1390           -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    1391      t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
    1392           -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    1393      !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
    1394      theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
    1395           -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
    1396      thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
    1397           -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
    1398      thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
    1399           -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
    1400      qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
    1401           -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
    1402      ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
    1403           -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
    1404      qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
    1405           -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
    1406      u_prof_cas(k) = u_cas(k,it_cas2)                                 &
    1407           -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    1408      v_prof_cas(k) = v_cas(k,it_cas2)                                 &
    1409           -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    1410      ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    1411           -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    1412      vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    1413           -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    1414      vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
    1415           -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    1416      omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
    1417           -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
    1418      du_prof_cas(k) = du_cas(k,it_cas2)                               &
    1419           -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    1420      hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
    1421           -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    1422      vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
    1423           -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    1424      dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
    1425           -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    1426      hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
    1427           -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    1428      vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
    1429           -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    1430      dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
    1431           -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    1432      ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
    1433           -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    1434      vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
    1435           -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    1436      dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
    1437           -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
    1438      hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
    1439           -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
    1440      vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
    1441           -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
    1442      dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
    1443           -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    1444      dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
    1445           -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    1446      hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
    1447           -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    1448      vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
    1449           -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    1450      uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
    1451           -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    1452      vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
    1453           -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1454      q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
    1455           -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1456      q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
    1457           -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1458   enddo
    1459 
    1460 
    1461 END SUBROUTINE interp2_case_time
    1462 
    1463 !**********************************************************************************************
     914      case(3) ; zzh = apbp
     915      case(4) ; pph = apbp
     916      case(5) ; temp0 = resul1    ! donnees initiales
     917      case(6) ; qv0 = resul1
     918      case(7) ; ql0 = resul1
     919      case(8) ; qi0 = resul1
     920      case(9) ; u0 = resul1
     921      case(10) ; v0 = resul1
     922      case(11) ; tke0 = resul1
     923      case(12) ; pp0 = resul1
     924      case(13) ; vitw = resul    ! donnees indexees en nlevel,time
     925      case(14) ; omega = resul
     926      case(15) ; ug = resul
     927      case(16) ; vg = resul
     928      case(17) ; du = resul
     929      case(18) ; hu = resul
     930      case(19) ; vu = resul
     931      case(20) ; dv = resul
     932      case(21) ; hv = resul
     933      case(22) ; vv = resul
     934      case(23) ; dt = resul
     935      case(24) ; ht = resul
     936      case(25) ; vt = resul
     937      case(26) ; dq = resul
     938      case(27) ; hq = resul
     939      case(28) ; vq = resul
     940      case(29) ; dth = resul
     941      case(30) ; hth = resul
     942      case(31) ; vth = resul
     943      case(32) ; hthl = resul
     944      case(33) ; dr = resul
     945      case(34) ; hr = resul
     946      case(35) ; vr = resul
     947      case(36) ; dtrad = resul
     948      case(37) ; q1 = resul
     949      case(38) ; q2 = resul
     950      case(39) ; uw = resul
     951      case(40) ; vw = resul
     952      case(41) ; rh = resul
     953      case(42) ; zz = resul      ! donnees en time,nlevel pour profil initial
     954      case(43) ; pp = resul
     955      case(44) ; temp = resul
     956      case(45) ; theta = resul
     957      case(46) ; thv = resul
     958      case(47) ; thl = resul
     959      case(48) ; qv = resul
     960      case(49) ; ql = resul
     961      case(50) ; qi = resul
     962      case(51) ; rv = resul
     963      case(52) ; u = resul
     964      case(53) ; v = resul
     965      case(54) ; tke = resul
     966      case(55) ; sens = resul2   ! donnees indexees en time
     967      case(56) ; flat = resul2
     968      case(57) ; ts = resul2
     969      case(58) ; ps = resul2
     970      case(59) ; ustar = resul2
     971      case(60) ; orog_cas = resul3      ! constantes
     972      case(61) ; albedo_cas = resul3
     973      case(62) ; emiss_cas = resul3
     974      case(63) ; t_skin_cas = resul3
     975      case(64) ; q_skin_cas = resul3
     976      case(65) ; mom_rough = resul3
     977      case(66) ; heat_rough = resul3
     978      case(67) ; o3_cas = resul3
     979      case(68) ; rugos_cas = resul3
     980      case(69) ; clay_cas = resul3
     981      case(70) ; sand_cas = resul3
     982      end select
     983      resul = 0.
     984      resul1 = 0.
     985      resul2 = 0.
     986      resul3 = 0.
     987    enddo
     988    PRINT*, 'Lecture de la variable APRES ,sens ', minval(sens), maxval(sens)
     989    PRINT*, 'Lecture de la variable APRES ,flat ', minval(flat), maxval(flat)
     990
     991    !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
     992    DO t = 1, ntime
     993      DO k = 1, nlevel
     994        temp(k, t) = temp0(k)
     995        qv(k, t) = qv0(k)
     996        ql(k, t) = ql0(k)
     997        qi(k, t) = qi0(k)
     998        u(k, t) = u0(k)
     999        v(k, t) = v0(k)
     1000        tke(k, t) = tke0(k)
     1001      enddo
     1002    enddo
     1003    !-----------------------------------------------------------------------
     1004
     1005  END SUBROUTINE  old_read_SCM
     1006  !======================================================================
     1007
     1008  !======================================================================
     1009  SUBROUTINE interp_case_time2(day, day1, annee_ref                &
     1010          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
     1011          , nt_cas, nlev_cas                                       &
     1012          , ts_cas, ps_cas, plev_cas, t_cas, q_cas, u_cas, v_cas               &
     1013          , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas           &
     1014          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas   &
     1015          , dq_cas, hq_cas, vq_cas, lat_cas, sens_cas, ustar_cas       &
     1016          , uw_cas, vw_cas, q1_cas, q2_cas                           &
     1017          , ts_prof_cas, plev_prof_cas, t_prof_cas, q_prof_cas       &
     1018          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas         &
     1019          , vitw_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas     &
     1020          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas       &
     1021          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas    &
     1022          , hq_prof_cas, vq_prof_cas, lat_prof_cas, sens_prof_cas    &
     1023          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas)
     1024
     1025    USE lmdz_compar1d
     1026    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     1027
     1028    IMPLICIT NONE
     1029
     1030    !---------------------------------------------------------------------------------------
     1031    ! Time interpolation of a 2D field to the timestep corresponding to day
     1032
     1033    ! day: current julian day (e.g. 717538.2)
     1034    ! day1: first day of the simulation
     1035    ! nt_cas: total nb of data in the forcing
     1036    ! pdt_cas: total time interval (in sec) between 2 forcing data
     1037    !---------------------------------------------------------------------------------------
     1038
     1039    ! inputs:
     1040    INTEGER annee_ref
     1041    INTEGER nt_cas, nlev_cas
     1042    REAL day, day1, day_cas
     1043    REAL ts_cas(nt_cas), ps_cas(nt_cas)
     1044    REAL plev_cas(nlev_cas, nt_cas)
     1045    REAL t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas)
     1046    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
     1047    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
     1048    REAL vitw_cas(nlev_cas, nt_cas)
     1049    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
     1050    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
     1051    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
     1052    REAL dtrad_cas(nlev_cas, nt_cas)
     1053    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
     1054    REAL lat_cas(nt_cas)
     1055    REAL sens_cas(nt_cas)
     1056    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
     1057    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
     1058
     1059    ! outputs:
     1060    REAL plev_prof_cas(nlev_cas)
     1061    REAL t_prof_cas(nlev_cas), q_prof_cas(nlev_cas)
     1062    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
     1063    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
     1064    REAL vitw_prof_cas(nlev_cas)
     1065    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
     1066    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
     1067    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
     1068    REAL dtrad_prof_cas(nlev_cas)
     1069    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
     1070    REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas
     1071    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
     1072    ! local:
     1073    INTEGER it_cas1, it_cas2, k
     1074    REAL timeit, time_cas1, time_cas2, frac
     1075
     1076    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
     1077
     1078    ! On teste si la date du cas AMMA est correcte.
     1079    ! C est pour memoire car en fait les fichiers .def
     1080    ! sont censes etre corrects.
     1081    ! A supprimer a terme (MPL 20150623)
     1082    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
     1083    ! Check that initial day of the simulation consistent with AMMA case:
     1084    !      if (annee_ref.NE.2006) THEN
     1085    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
     1086    !       PRINT*,'Changer annee_ref dans run.def'
     1087    !       stop
     1088    !      endif
     1089    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
     1090    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     1091    !       PRINT*,'Changer dayref dans run.def'
     1092    !       stop
     1093    !      endif
     1094    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
     1095    !       PRINT*,'AMMA a fini le 11 juillet'
     1096    !       PRINT*,'Changer dayref ou nday dans run.def'
     1097    !       stop
     1098    !      endif
     1099    !      endif
     1100
     1101    ! Determine timestep relative to the 1st day:
     1102    !       timeit=(day-day1)*86400.
     1103    !       if (annee_ref.EQ.1992) THEN
     1104    !        timeit=(day-day_cas)*86400.
     1105    !       else
     1106    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     1107    !       endif
     1108    timeit = (day - day_ju_ini_cas) * 86400
     1109    !print *,'day=',day
     1110    !print *,'day_ju_ini_cas=',day_ju_ini_cas
     1111    !print *,'pdt_cas=',pdt_cas
     1112    !print *,'timeit=',timeit
     1113    !print *,'nt_cas=',nt_cas
     1114
     1115    ! Determine the closest observation times:
     1116    !       it_cas1=INT(timeit/pdt_cas)+1
     1117    !       it_cas2=it_cas1 + 1
     1118    !       time_cas1=(it_cas1-1)*pdt_cas
     1119    !       time_cas2=(it_cas2-1)*pdt_cas
     1120
     1121    it_cas1 = INT(timeit / pdt_cas) + 1
     1122    IF (it_cas1 == nt_cas) THEN
     1123      it_cas2 = it_cas1
     1124    ELSE
     1125      it_cas2 = it_cas1 + 1
     1126    ENDIF
     1127    time_cas1 = (it_cas1 - 1) * pdt_cas
     1128    time_cas2 = (it_cas2 - 1) * pdt_cas
     1129    !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
     1130
     1131    IF (it_cas1 > nt_cas) THEN
     1132      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     1133              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
     1134      stop
     1135    ENDIF
     1136
     1137    ! time interpolation:
     1138    IF (it_cas1 == it_cas2) THEN
     1139      frac = 0.
     1140    ELSE
     1141      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
     1142      frac = max(frac, 0.0)
     1143    ENDIF
     1144
     1145    lat_prof_cas = lat_cas(it_cas2)                                       &
     1146            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
     1147    sens_prof_cas = sens_cas(it_cas2)                                     &
     1148            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
     1149    ts_prof_cas = ts_cas(it_cas2)                                         &
     1150            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
     1151    ustar_prof_cas = ustar_cas(it_cas2)                                   &
     1152            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
     1153
     1154    DO k = 1, nlev_cas
     1155      plev_prof_cas(k) = plev_cas(k, it_cas2)                               &
     1156              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
     1157      t_prof_cas(k) = t_cas(k, it_cas2)                               &
     1158              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
     1159      q_prof_cas(k) = q_cas(k, it_cas2)                               &
     1160              - frac * (q_cas(k, it_cas2) - q_cas(k, it_cas1))
     1161      u_prof_cas(k) = u_cas(k, it_cas2)                               &
     1162              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
     1163      v_prof_cas(k) = v_cas(k, it_cas2)                               &
     1164              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
     1165      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
     1166              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
     1167      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
     1168              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
     1169      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                               &
     1170              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
     1171      du_prof_cas(k) = du_cas(k, it_cas2)                                   &
     1172              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
     1173      hu_prof_cas(k) = hu_cas(k, it_cas2)                                   &
     1174              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
     1175      vu_prof_cas(k) = vu_cas(k, it_cas2)                                   &
     1176              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
     1177      dv_prof_cas(k) = dv_cas(k, it_cas2)                                   &
     1178              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
     1179      hv_prof_cas(k) = hv_cas(k, it_cas2)                                   &
     1180              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
     1181      vv_prof_cas(k) = vv_cas(k, it_cas2)                                   &
     1182              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
     1183      dt_prof_cas(k) = dt_cas(k, it_cas2)                                   &
     1184              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
     1185      ht_prof_cas(k) = ht_cas(k, it_cas2)                                   &
     1186              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
     1187      vt_prof_cas(k) = vt_cas(k, it_cas2)                                   &
     1188              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
     1189      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                                   &
     1190              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
     1191      dq_prof_cas(k) = dq_cas(k, it_cas2)                                   &
     1192              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
     1193      hq_prof_cas(k) = hq_cas(k, it_cas2)                                   &
     1194              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
     1195      vq_prof_cas(k) = vq_cas(k, it_cas2)                                   &
     1196              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
     1197      uw_prof_cas(k) = uw_cas(k, it_cas2)                                   &
     1198              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
     1199      vw_prof_cas(k) = vw_cas(k, it_cas2)                                   &
     1200              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
     1201      q1_prof_cas(k) = q1_cas(k, it_cas2)                                   &
     1202              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
     1203      q2_prof_cas(k) = q2_cas(k, it_cas2)                                   &
     1204              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
     1205    enddo
     1206
     1207  END SUBROUTINE interp_case_time2
     1208
     1209  !**********************************************************************************************
     1210  SUBROUTINE interp2_case_time(day, day1, annee_ref                           &
     1211          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
     1212          , nt_cas, nlev_cas                                                   &
     1213          , ts_cas, ps_cas, plev_cas, t_cas, theta_cas, thv_cas, thl_cas            &
     1214          , qv_cas, ql_cas, qi_cas, u_cas, v_cas                                  &
     1215          , ug_cas, vg_cas, vitw_cas, omega_cas, du_cas, hu_cas, vu_cas             &
     1216          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas               &
     1217          , dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas                      &
     1218          , lat_cas, sens_cas, ustar_cas                                        &
     1219          , uw_cas, vw_cas, q1_cas, q2_cas, tke_cas                               &
     1220
     1221          , ts_prof_cas, plev_prof_cas, t_prof_cas, theta_prof_cas               &
     1222          , thv_prof_cas, thl_prof_cas, qv_prof_cas, ql_prof_cas, qi_prof_cas     &
     1223          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas                     &
     1224          , vitw_prof_cas, omega_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas  &
     1225          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas                   &
     1226          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas                &
     1227          , hq_prof_cas, vq_prof_cas, dth_prof_cas, hth_prof_cas, vth_prof_cas    &
     1228          , lat_prof_cas, sens_prof_cas                                        &
     1229          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tke_prof_cas)
     1230
     1231    USE lmdz_compar1d
     1232    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     1233
     1234    IMPLICIT NONE
     1235
     1236    !---------------------------------------------------------------------------------------
     1237    ! Time interpolation of a 2D field to the timestep corresponding to day
     1238
     1239    ! day: current julian day (e.g. 717538.2)
     1240    ! day1: first day of the simulation
     1241    ! nt_cas: total nb of data in the forcing
     1242    ! pdt_cas: total time interval (in sec) between 2 forcing data
     1243    !---------------------------------------------------------------------------------------
     1244
     1245    ! inputs:
     1246    INTEGER annee_ref
     1247    INTEGER nt_cas, nlev_cas
     1248    REAL day, day1, day_cas
     1249    REAL ts_cas(nt_cas), ps_cas(nt_cas)
     1250    REAL plev_cas(nlev_cas, nt_cas)
     1251    REAL t_cas(nlev_cas, nt_cas), theta_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas)
     1252    REAL qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), qi_cas(nlev_cas, nt_cas)
     1253    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
     1254    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
     1255    REAL vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas)
     1256    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
     1257    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
     1258    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
     1259    REAL dth_cas(nlev_cas, nt_cas), hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas)
     1260    REAL dtrad_cas(nlev_cas, nt_cas)
     1261    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
     1262    REAL lat_cas(nt_cas), sens_cas(nt_cas), tke_cas(nt_cas)
     1263    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
     1264    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
     1265
     1266    ! outputs:
     1267    REAL plev_prof_cas(nlev_cas)
     1268    REAL t_prof_cas(nlev_cas), theta_prof_cas(nlev_cas), thl_prof_cas(nlev_cas), thv_prof_cas(nlev_cas)
     1269    REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
     1270    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
     1271    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
     1272    REAL vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas)
     1273    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
     1274    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
     1275    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
     1276    REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
     1277    REAL dtrad_prof_cas(nlev_cas)
     1278    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
     1279    REAL lat_prof_cas, sens_prof_cas, tke_prof_cas, ts_prof_cas, ustar_prof_cas
     1280    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
     1281    ! local:
     1282    INTEGER it_cas1, it_cas2, k
     1283    REAL timeit, time_cas1, time_cas2, frac
     1284
     1285    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
     1286    !       do k=1,nlev_cas
     1287    !       PRINT*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
     1288    !       enddo
     1289
     1290    ! On teste si la date du cas AMMA est correcte.
     1291    ! C est pour memoire car en fait les fichiers .def
     1292    ! sont censes etre corrects.
     1293    ! A supprimer a terme (MPL 20150623)
     1294    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
     1295    ! Check that initial day of the simulation consistent with AMMA case:
     1296    !      if (annee_ref.NE.2006) THEN
     1297    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
     1298    !       PRINT*,'Changer annee_ref dans run.def'
     1299    !       stop
     1300    !      endif
     1301    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
     1302    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     1303    !       PRINT*,'Changer dayref dans run.def'
     1304    !       stop
     1305    !      endif
     1306    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
     1307    !       PRINT*,'AMMA a fini le 11 juillet'
     1308    !       PRINT*,'Changer dayref ou nday dans run.def'
     1309    !       stop
     1310    !      endif
     1311    !      endif
     1312
     1313    ! Determine timestep relative to the 1st day:
     1314    !       timeit=(day-day1)*86400.
     1315    !       if (annee_ref.EQ.1992) THEN
     1316    !        timeit=(day-day_cas)*86400.
     1317    !       else
     1318    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     1319    !       endif
     1320    timeit = (day - day_ju_ini_cas) * 86400
     1321    !print *,'day=',day
     1322    !print *,'day_ju_ini_cas=',day_ju_ini_cas
     1323    !print *,'pdt_cas=',pdt_cas
     1324    !print *,'timeit=',timeit
     1325    !print *,'nt_cas=',nt_cas
     1326
     1327    ! Determine the closest observation times:
     1328    !       it_cas1=INT(timeit/pdt_cas)+1
     1329    !       it_cas2=it_cas1 + 1
     1330    !       time_cas1=(it_cas1-1)*pdt_cas
     1331    !       time_cas2=(it_cas2-1)*pdt_cas
     1332
     1333    it_cas1 = INT(timeit / pdt_cas) + 1
     1334    IF (it_cas1 == nt_cas) THEN
     1335      it_cas2 = it_cas1
     1336    ELSE
     1337      it_cas2 = it_cas1 + 1
     1338    ENDIF
     1339    time_cas1 = (it_cas1 - 1) * pdt_cas
     1340    time_cas2 = (it_cas2 - 1) * pdt_cas
     1341    !print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
     1342    !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
     1343
     1344    IF (it_cas1 > nt_cas) THEN
     1345      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     1346              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
     1347      stop
     1348    ENDIF
     1349
     1350    ! time interpolation:
     1351    IF (it_cas1 == it_cas2) THEN
     1352      frac = 0.
     1353    ELSE
     1354      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
     1355      frac = max(frac, 0.0)
     1356    ENDIF
     1357
     1358    lat_prof_cas = lat_cas(it_cas2)                                   &
     1359            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
     1360    sens_prof_cas = sens_cas(it_cas2)                                 &
     1361            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
     1362    tke_prof_cas = tke_cas(it_cas2)                                   &
     1363            - frac * (tke_cas(it_cas2) - tke_cas(it_cas1))
     1364    ts_prof_cas = ts_cas(it_cas2)                                     &
     1365            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
     1366    ustar_prof_cas = ustar_cas(it_cas2)                               &
     1367            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
     1368
     1369    DO k = 1, nlev_cas
     1370      plev_prof_cas(k) = plev_cas(k, it_cas2)                           &
     1371              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
     1372      t_prof_cas(k) = t_cas(k, it_cas2)                                 &
     1373              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
     1374      !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
     1375      theta_prof_cas(k) = theta_cas(k, it_cas2)                         &
     1376              - frac * (theta_cas(k, it_cas2) - theta_cas(k, it_cas1))
     1377      thv_prof_cas(k) = thv_cas(k, it_cas2)                             &
     1378              - frac * (thv_cas(k, it_cas2) - thv_cas(k, it_cas1))
     1379      thl_prof_cas(k) = thl_cas(k, it_cas2)                             &
     1380              - frac * (thl_cas(k, it_cas2) - thl_cas(k, it_cas1))
     1381      qv_prof_cas(k) = qv_cas(k, it_cas2)                               &
     1382              - frac * (qv_cas(k, it_cas2) - qv_cas(k, it_cas1))
     1383      ql_prof_cas(k) = ql_cas(k, it_cas2)                               &
     1384              - frac * (ql_cas(k, it_cas2) - ql_cas(k, it_cas1))
     1385      qi_prof_cas(k) = qi_cas(k, it_cas2)                               &
     1386              - frac * (qi_cas(k, it_cas2) - qi_cas(k, it_cas1))
     1387      u_prof_cas(k) = u_cas(k, it_cas2)                                 &
     1388              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
     1389      v_prof_cas(k) = v_cas(k, it_cas2)                                 &
     1390              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
     1391      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
     1392              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
     1393      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
     1394              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
     1395      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                           &
     1396              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
     1397      omega_prof_cas(k) = omega_cas(k, it_cas2)                         &
     1398              - frac * (omega_cas(k, it_cas2) - omega_cas(k, it_cas1))
     1399      du_prof_cas(k) = du_cas(k, it_cas2)                               &
     1400              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
     1401      hu_prof_cas(k) = hu_cas(k, it_cas2)                               &
     1402              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
     1403      vu_prof_cas(k) = vu_cas(k, it_cas2)                               &
     1404              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
     1405      dv_prof_cas(k) = dv_cas(k, it_cas2)                               &
     1406              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
     1407      hv_prof_cas(k) = hv_cas(k, it_cas2)                               &
     1408              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
     1409      vv_prof_cas(k) = vv_cas(k, it_cas2)                               &
     1410              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
     1411      dt_prof_cas(k) = dt_cas(k, it_cas2)                               &
     1412              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
     1413      ht_prof_cas(k) = ht_cas(k, it_cas2)                               &
     1414              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
     1415      vt_prof_cas(k) = vt_cas(k, it_cas2)                               &
     1416              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
     1417      dth_prof_cas(k) = dth_cas(k, it_cas2)                             &
     1418              - frac * (dth_cas(k, it_cas2) - dth_cas(k, it_cas1))
     1419      hth_prof_cas(k) = hth_cas(k, it_cas2)                             &
     1420              - frac * (hth_cas(k, it_cas2) - hth_cas(k, it_cas1))
     1421      vth_prof_cas(k) = vth_cas(k, it_cas2)                             &
     1422              - frac * (vth_cas(k, it_cas2) - vth_cas(k, it_cas1))
     1423      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                         &
     1424              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
     1425      dq_prof_cas(k) = dq_cas(k, it_cas2)                               &
     1426              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
     1427      hq_prof_cas(k) = hq_cas(k, it_cas2)                               &
     1428              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
     1429      vq_prof_cas(k) = vq_cas(k, it_cas2)                               &
     1430              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
     1431      uw_prof_cas(k) = uw_cas(k, it_cas2)                                &
     1432              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
     1433      vw_prof_cas(k) = vw_cas(k, it_cas2)                                &
     1434              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
     1435      q1_prof_cas(k) = q1_cas(k, it_cas2)                                &
     1436              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
     1437      q2_prof_cas(k) = q2_cas(k, it_cas2)                                &
     1438              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
     1439    enddo
     1440
     1441  END SUBROUTINE interp2_case_time
     1442
     1443  !**********************************************************************************************
    14641444
    14651445END MODULE mod_1D_cases_read2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90

    r5144 r5158  
    8686  !**********************************************************************************************
    8787  SUBROUTINE read_SCM_cas
     88    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     89
    8890    IMPLICIT NONE
    89 
    90     INCLUDE "date_cas.h"
    9191
    9292    INTEGER nid, rid, ierr
    … …  
    239239            o3_cas, rugos_cas, clay_cas, sand_cas)
    240240    PRINT*, 'read_SCM cas OK'
    241     do ii = 1, nlev_cas
     241    DO ii = 1, nlev_cas
    242242      PRINT*, 'apres read_SCM_cas, plev_cas=', ii, plev_cas(ii, 1)
    243243      !PRINT*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
    … …  
    325325
    326326    !program reading forcing of the case study
     327    USE lmdz_compar1d
     328
    327329    IMPLICIT NONE
    328     INCLUDE "compar1d.h"
    329330
    330331    INTEGER ntime, nlevel, k, t
    … …  
    419420    !-----------------------------------------------------------------------
    420421
    421     do i = 1, nbvar3d
     422    DO i = 1, nbvar3d
    422423      missing_var(i) = 0.
    423424      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
    … …  
    596597
    597598    !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
    598     do t = 1, ntime
    599       do k = 1, nlevel
     599    DO t = 1, ntime
     600      DO k = 1, nlevel
    600601        temp(k, t) = temp0(k)
    601602        qv(k, t) = qv0(k)
    … …  
    644645          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tkes_prof_cas)
    645646
     647    USE lmdz_compar1d
     648    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
     649
    646650    IMPLICIT NONE
    647651
    … …  
    654658    ! pdt_cas: total time interval (in sec) between 2 forcing data
    655659    !---------------------------------------------------------------------------------------
    656 
    657     INCLUDE "compar1d.h"
    658     INCLUDE "date_cas.h"
    659660
    660661    ! inputs:
    … …  
    799800            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
    800801
    801     do k = 1, nlev_cas
     802    DO k = 1, nlev_cas
    802803      plev_prof_cas(k) = plev_cas(k, it_cas2)                           &
    803804              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
    … …  
    970971    ! for variables defined at the middle of layers
    971972
    972     do l = 1, llm
     973    DO l = 1, llm
    973974
    974975      IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
    … …  
    979980
    980981        IF (play(l)<=plev_prof_cas(1)) THEN
    981           do k = 1, nlev_cas - 1
     982          DO k = 1, nlev_cas - 1
    982983            IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
    983984              k1 = k
    … …  
    989990            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
    990991            WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
    991             do k = 1, nlev_cas - 1
     992            DO k = 1, nlev_cas - 1
    992993              WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
    993994            enddo
    … …  
    11411142    ! for variables defined at layer interfaces (EV):
    11421143
    1143     do l = 1, llm + 1
     1144    DO l = 1, llm + 1
    11441145
    11451146      IF (plev(l)>=plev_prof_cas(nlev_cas)) THEN
    … …  
    11491150
    11501151        IF (plev(l)<=plev_prof_cas(1)) THEN
    1151           do k = 1, nlev_cas - 1
     1152          DO k = 1, nlev_cas - 1
    11521153            IF (plev(l)<=plev_prof_cas(k).AND. plev(l)>plev_prof_cas(k + 1)) THEN
    11531154              k1 = k
    … …  
    11591160            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
    11601161            WRITE(*, *) 'l,plev(l) = ', l, plev(l) / 100
    1161             do k = 1, nlev_cas - 1
     1162            DO k = 1, nlev_cas - 1
    11621163              WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
    11631164            enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h

    r5144 r5158  
    2929      open(21,file=trim(fich_toga),form='formatted')
    3030      read(21,'(a)')
    31       do ip = 1, nt_toga
     31      DO ip = 1, nt_toga
    3232      read(21,'(a)')
    3333      read(21,'(a)')
    … …  
    3636      read(21,'(a)')
    3737
    38        do k = 1, nlev_toga
     38       DO k = 1, nlev_toga
    3939         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip)          &
    4040     &       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)                     &
    … …  
    8585      open(21,file=trim(fich_sandu),form='formatted')
    8686      read(21,'(a)')
    87       do ip = 1, nt_sandu
     87      DO ip = 1, nt_sandu
    8888      read(21,'(a)')
    8989      read(21,'(a)')
    … …  
    124124      read(21,'(a)')
    125125      read(21,'(a)')
    126       do ip = 1, nt_astex
     126      DO ip = 1, nt_astex
    127127      read(21,'(a)')
    128128      read(21,'(a)')
    … …  
    308308
    309309!pressure
    310        do l=1,ntime
    311        do k=1,nlevel
     310       DO l=1,ntime
     311       DO k=1,nlevel
    312312          plev(k,l)=lev(k)
    313313       enddo
    … …  
    356356!         WRITE(*,*)'lecture q ok'
    357357!q in kg/kg
    358        do l=1,ntime
    359        do k=1,nlevel
     358       DO l=1,ntime
     359       DO k=1,nlevel
    360360          q(k,l)=q(k,l)/1000.
    361361       enddo
    … …  
    382382!         WRITE(*,*)'lecture omega ok'
    383383!omega in mb/hour
    384        do l=1,ntime
    385        do k=1,nlevel
     384       DO l=1,ntime
     385       DO k=1,nlevel
    386386          omega(k,l)=omega(k,l)*100./3600.
    387387       enddo
    … …  
    402402!         WRITE(*,*)'lecture T_adv_h ok'
    403403!T adv in K/s
    404        do l=1,ntime
    405        do k=1,nlevel
     404       DO l=1,ntime
     405       DO k=1,nlevel
    406406          T_adv_h(k,l)=T_adv_h(k,l)/3600.
    407407       enddo
    … …  
    416416!         WRITE(*,*)'lecture T_adv_v ok'
    417417!T adv in K/s
    418        do l=1,ntime
    419        do k=1,nlevel
     418       DO l=1,ntime
     419       DO k=1,nlevel
    420420          T_adv_v(k,l)=T_adv_v(k,l)/3600.
    421421       enddo
    … …  
    429429!         WRITE(*,*)'lecture q_adv_h ok'
    430430!q adv in kg/kg/s
    431        do l=1,ntime
    432        do k=1,nlevel
     431       DO l=1,ntime
     432       DO k=1,nlevel
    433433          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
    434434       enddo
    … …  
    443443!         WRITE(*,*)'lecture q_adv_v ok'
    444444!q adv in kg/kg/s
    445        do l=1,ntime
    446        do k=1,nlevel
     445       DO l=1,ntime
     446       DO k=1,nlevel
    447447          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
    448448       enddo
    … …  
    572572       REAL frac,frac1,frac2,fact
    573573
    574        do l = 1, llm
     574       DO l = 1, llm
    575575
    576576        IF (play(l).ge.plev_prof(nlev_sandu)) THEN
    … …  
    580580
    581581         IF (play(l).le.plev_prof(1)) THEN
    582          do k = 1, nlev_sandu-1
     582         DO k = 1, nlev_sandu-1
    583583          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
    584584            k1=k
    … …  
    590590          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    591591          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    592          do k = 1, nlev_sandu-1
     592         DO k = 1, nlev_sandu-1
    593593          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
    594594         enddo
    … …  
    641641       enddo ! l
    642642
    643        do l = 1,llm
     643       DO l = 1,llm
    644644!      print *,'t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l) ',
    645645!    $        l,t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l)
    … …  
    685685       REAL frac,frac1,frac2,fact
    686686
    687        do l = 1, llm
     687       DO l = 1, llm
    688688
    689689        IF (play(l).ge.plev_prof(nlev_astex)) THEN
    … …  
    693693
    694694         IF (play(l).le.plev_prof(1)) THEN
    695          do k = 1, nlev_astex-1
     695         DO k = 1, nlev_astex-1
    696696          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
    697697            k1=k
    … …  
    703703          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    704704          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    705          do k = 1, nlev_astex-1
     705         DO k = 1, nlev_astex-1
    706706          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
    707707         enddo
    … …  
    760760       enddo ! l
    761761
    762        do l = 1,llm
     762       DO l = 1,llm
    763763!      print *,'t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l) ',
    764764!    $        l,t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l)
    … …  
    801801      PRINT*,fich_rico
    802802      open(21,file=trim(fich_rico),form='formatted')
    803         do k=1,llm
     803        DO k=1,llm
    804804      zlay(k)=0.
    805805         enddo
    … …  
    808808        prico(1)=ps_rico
    809809        zrico(1)=0.0
    810       do l=2,nlev_rico
     810      DO l=2,nlev_rico
    811811        read(21,*) k,prico(l),zrico(l)
    812812      enddo
    813813       close(21)
    814814
    815       do k=1,llm
    816         do l=1,80
     815      DO k=1,llm
     816        DO l=1,80
    817817          IF(prico(l)>play(k)) THEN
    818818              IF(play(k)>prico(l+1)) THEN
    … …  
    922922      enddo
    923923
    924       do k=1,llm
     924      DO k=1,llm
    925925      q_rico(k)=q_rico(k)/1e3
    926926      dqh_dyn(k)=dqh_dyn(k)/1e3
    … …  
    10291029      open(21,file=trim(fich_armcu),form='formatted')
    10301030      read(21,'(a)')
    1031       do ip = 1, nt_armcu
     1031      DO ip = 1, nt_armcu
    10321032      read(21,'(a)')
    10331033      read(21,'(a)')
    … …  
    10821082       REAL frac,frac1,frac2,fact
    10831083 
    1084        do l = 1, llm
     1084       DO l = 1, llm
    10851085
    10861086        IF (play(l).ge.plev_prof(nlev_toga)) THEN
    … …  
    10901090
    10911091         IF (play(l).le.plev_prof(1)) THEN
    1092          do k = 1, nlev_toga-1
     1092         DO k = 1, nlev_toga-1
    10931093          IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
    10941094            k1=k
    … …  
    11001100          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    11011101          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    1102          do k = 1, nlev_toga-1
     1102         DO k = 1, nlev_toga-1
    11031103          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
    11041104         enddo
    … …  
    12081208       REAL frac,frac1,frac2,fact
    12091209 
    1210        do l = 1, llm
     1210       DO l = 1, llm
    12111211
    12121212        IF (play(l).ge.plev_prof_cas(nlev_cas)) THEN
    … …  
    12161216
    12171217         IF (play(l).le.plev_prof_cas(1)) THEN
    1218          do k = 1, nlev_cas-1
     1218         DO k = 1, nlev_cas-1
    12191219          IF (play(l).le.plev_prof_cas(k).AND. play(l).gt.plev_prof_cas(k+1)) THEN
    12201220            k1=k
    … …  
    12261226          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    12271227          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    1228          do k = 1, nlev_cas-1
     1228         DO k = 1, nlev_cas-1
    12291229          WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
    12301230         enddo
    … …  
    13561356       REAL aa,frac,frac1,frac2,fact
    13571357 
    1358        do l = 1, llm
     1358       DO l = 1, llm
    13591359
    13601360        IF (play(l).ge.plev_prof(nlev_dice)) THEN
    … …  
    13641364
    13651365         IF (play(l).le.plev_prof(1)) THEN
    1366          do k = 1, nlev_dice-1
     1366         DO k = 1, nlev_dice-1
    13671367          IF (play(l).le.plev_prof(k) .AND. play(l).gt.plev_prof(k+1)) THEN
    13681368            k1=k
    … …  
    13741374          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
    13751375          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
    1376          do k = 1, nlev_dice-1
     1376         DO k = 1, nlev_dice-1
    13771377          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
    13781378         enddo
    … …  
    15401540     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof   &
    15411541     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
     1542
     1543     USE lmdz_compar1d
     1544
    15421545        IMPLICIT NONE
    15431546
    … …  
    15501553! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
    15511554!---------------------------------------------------------------------------------------
    1552 
    1553         INCLUDE "compar1d.h"
    15541555
    15551556! inputs:
    … …  
    16461647!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
    16471648
    1648        do k=1,nlev_toga
     1649       DO k=1,nlev_toga
    16491650        plev_prof(k) = 100.*(plev_toga(k,it_toga2)                         &
    16501651     &          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
    … …  
    16811682     &             ,ustar_prof,psurf_prof,ug_prof,vg_prof                 &
    16821683     &             ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof)
     1684
     1685     USE lmdz_compar1d
     1686
    16831687        IMPLICIT NONE
    16841688
    … …  
    16911695! dt_dice: total time interval (in sec) between 2 forcing data (e.g. 30min. for Dice)
    16921696!---------------------------------------------------------------------------------------
    1693 
    1694         INCLUDE "compar1d.h"
    16951697
    16961698! inputs:
    … …  
    17771779!     :day,annee_ref,day_ini_dice,timeit/86400.,it_dice1,it_dice2,ts_prof
    17781780
    1779        do k=1,nlev_dice
     1781       DO k=1,nlev_dice
    17801782        ht_prof(k) = ht_dice(k,it_dice2)-frac*(ht_dice(k,it_dice2)-ht_dice(k,it_dice1))
    17811783        hq_prof(k) = hq_dice(k,it_dice2)-frac*(hq_dice(k,it_dice2)-hq_dice(k,it_dice1))
    … …  
    17941796     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                          &
    17951797     &             ,ug_prof,vg_prof,ht_prof,hq_prof,tg_prof)
     1798
     1799     USE lmdz_compar1d
     1800
    17961801        IMPLICIT NONE
    17971802
    … …  
    18041809! dt_gabls4: total time interval (in sec) between 2 forcing data (e.g. 60min. for gabls4)
    18051810!---------------------------------------------------------------------------------------
    1806 
    1807         INCLUDE "compar1d.h"
    18081811
    18091812! inputs:
    … …  
    18661869
    18671870
    1868        do k=1,nlev_gabls4
     1871       DO k=1,nlev_gabls4
    18691872        ug_prof(k) = ug_gabls4(k,it_gabls42)-frac*(ug_gabls4(k,it_gabls42)-ug_gabls4(k,it_gabls41))
    18701873        vg_prof(k) = vg_gabls4(k,it_gabls42)-frac*(vg_gabls4(k,it_gabls42)-vg_gabls4(k,it_gabls41))
    … …  
    19821985        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    19831986        read (ilesfile,*) kmax
    1984         do k=1,kmax
     1987        DO k=1,kmax
    19851988          read (ilesfile,*) height1(k),thlprof(k),qtprof (k),               &
    19861989     &                      uprof (k),vprof  (k),e12prof(k)
    … …  
    19961999          stop 'lecture profiles'
    19972000        endif
    1998         do k=1,kmax
     2001        DO k=1,kmax
    19992002          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),         &
    20002003     &                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
    20012004        END DO
    2002         do k=1,kmax
     2005        DO k=1,kmax
    20032006          IF (height(k) .NE. height1(k)) THEN
    20042007            print *, 'fichiers prof.inp et lscale.inp incompatibles :'
    … …  
    20222025          stop 'lecture profiles'
    20232026        endif
    2024         do k=1,kmax
     2027        DO k=1,kmax
    20252028          read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
    20262029        END DO
    … …  
    20522055        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    20532056        read (ilesfile,*) kmax
    2054         do k=1,kmax
     2057        DO k=1,kmax
    20552058          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
    20562059     &                      qprof (k),uprof(k),  vprof(k),  wprof(k),      &
    … …  
    20842087        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    20852088        read (ilesfile,*) kmax
    2086         do k=1,kmax
     2089        DO k=1,kmax
    20872090          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
    20882091     &                qvprof (k),qlprof (k),qtprof (k),                    &
    … …  
    21262129        IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
    21272130        read (ilesfile,*) kmax
    2128         do k=1,kmax
     2131        DO k=1,kmax
    21292132          read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),   &
    21302133     &                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
    … …  
    21432146       ENDIF
    21442147        read (ifile,*) kmax
    2145         do k=1,kmax
     2148        DO k=1,kmax
    21462149          read (ifile,*) jtot,aprof(k),bprof(k)
    21472150        enddo
    … …  
    25592562         endif
    25602563!          WRITE(*,*)'lecture th ok',th
    2561            do k=1,nlevel
     2564           DO k=1,nlevel
    25622565             t(k)=th(k)*(pres(k)/pzero)**rkappa
    25632566           enddo
    … …  
    29252928
    29262929! On remet les variables lues dans le bon ordre des niveaux (MPL 20141024)
    2927          do k=1,nlevel
     2930         DO k=1,nlevel
    29282931           zz(k)=zz_i(nlevel+1-k)
    29292932           ug(k,:)=ug_i(nlevel+1-k,:)
    … …  
    29482951
    29492952      USE lmdz_yomcst
    2950      
     2953
     2954      INTEGER :: ncm_1, nlev_circ, ilev, iskip, icm_1, il
    29512955      parameter (ncm_1=49180)
    29522956
    2953       REAL albsfc(ncm_1), albsfc_w(ncm_1)
     2957      REAL albsfc(ncm_1), albsfc_w(ncm_1), aer_alpha, sw_dn_toa, tsfc
    29542958      REAL cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
    29552959           reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
    … …  
    29752979     
    29762980!     Read scalar information
    2977       do iskip=1,5
     2981      DO iskip=1,5
    29782982         read (11, *)
    29792983      enddo
    … …  
    29882992!     Read level information
    29892993      read (12, *)
    2990       do il=1,nlev
     2994      DO il=1,nlev
    29912995         read (12, 302) ilev, z(il), p(il), t(il)
    29922996         z(il)=z(il)*1000.    ! z donne en km
    … …  
    29973001
    29983002!     Read layer information (midpoint values)
    2999       do iskip=1,3
     3003      DO iskip=1,3
    30003004         read (13, *)
    30013005      enddo
    3002       do il=1,nlev-1
     3006      DO il=1,nlev-1
    30033007         read (13, 303) ilev,pm(il),tm(il),h2o(il),co2(il),o3(il), &
    30043008                        n2o(il),co(il),ch4(il),o2(il),ccl4(il), &
    … …  
    30103014     
    30113015!     Read aerosol layer information
    3012       do iskip=1,3
     3016      DO iskip=1,3
    30133017         read (14, *)
    30143018      enddo
    … …  
    30163020      read (14, *)
    30173021      read (14, *)
    3018       do il=1,nlev-1
     3022      DO il=1,nlev-1
    30193023         read (14, 304) ilev, aer_beta(il), waer(il), gaer(il)
    30203024      enddo
    … …  
    30233027     
    30243028!     Read cloud information
    3025       do iskip=1,3
     3029      DO iskip=1,3
    30263030         read (15, *)
    30273031      enddo
    3028       do il=1,nlev-1
     3032      DO il=1,nlev-1
    30293033         read (15, 305) ilev, cf(il), lwp(il), iwp(il), reliq(il), reice(il)
    30303034         lwp(il)=lwp(il)/1000.          ! lwp donne en g/kg
    … …  
    30373041
    30383042!     Read surface albedo (weighted & unweighted) and spectral solar irradiance
    3039       do iskip=1,6
     3043      DO iskip=1,6
    30403044         read (16, *)
    30413045      enddo
    3042       do icm_1=1,ncm_1
     3046      DO icm_1=1,ncm_1
    30433047         read (16, 306) wavn(icm_1), albsfc(icm_1), albsfc_w(icm_1), ssf(icm_1)
    30443048      enddo
    … …  
    30553059      USE lmdz_yomcst
    30563060
     3061      INTEGER nlev_rtmip, il
    30573062      REAL t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
    30583063      REAL temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
    … …  
    30663071!     Read level information
    30673072      read (11, *)
    3068       do il=1,nlev_rtmip
     3073      DO il=1,nlev_rtmip
    30693074         read (11, 302) pt(il), pb(il), t(il),h2o(il),o3(il)
    30703075      enddo
    3071       do il=1,nlev_rtmip
     3076      DO il=1,nlev_rtmip
    30723077         play(il)=pt(nlev_rtmip-il+1)*100.     ! p donne en mb
    30733078         temp(il)=t(nlev_rtmip-il+1)
    … …  
    30753080         oz(il)=o3(nlev_rtmip-il+1)
    30763081      enddo
    3077       do il=1,39
     3082      DO il=1,39
    30783083         plev(il)=play(il)+(play(il+1)-play(il))/2.
    30793084         print *,'il p t ovap oz=',il,plev(il),temp(il),ovap(il),oz(il)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h

    r5117 r5158  
    2626! large-scale forcing :
    2727!!!      tsurf = ts_gcssold
    28       do l = 1, llm
     28      DO l = 1, llm
    2929!       u(l) = hu_gcssold(l) !  on prescrit le vent
    3030!       v(l) = hv_gcssold(l)    !  on prescrit le vent
    … …  
    7272! large-scale forcing :
    7373      tsurf = ts_prof
    74       do l = 1, llm
     74      DO l = 1, llm
    7575       u(l) = u_mod(l) ! sb: on prescrit le vent
    7676       v(l) = v_mod(l) ! sb: on prescrit le vent
    … …  
    169169      tg=tg_prof
    170170      print *,'ust= ',ust
    171       do l = 1, llm
     171      DO l = 1, llm
    172172       ug(l)= ug_profd
    173173       vg(l)= vg_profd
    … …  
    217217     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
    218218
    219       do l = 1, llm
     219      DO l = 1, llm
    220220       ug(l)= ug_mod(l)
    221221       vg(l)= vg_mod(l)
    … …  
    276276
    277277!wind nudging above 500m with a 2h time scale
    278         do l=1,llm
     278        DO l=1,llm
    279279        IF (nudge_wind) THEN
    280280!           if (phi(l).gt.5000.) THEN
    … …  
    291291!CR:nudging of q and theta with a 6h time scale above 15km
    292292        IF (nudge_thermo) THEN
    293         do l=1,llm
     293        DO l=1,llm
    294294           zz(l)=phi(l)/9.8
    295295           IF ((zz(l).le.16000.).AND.(zz(l).gt.15000.)) THEN
    … …  
    304304        endif
    305305
    306       do l = 1, llm
     306      DO l = 1, llm
    307307       omega(l) = w_mod(l)
    308308       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
    … …  
    343343      PRINT*,'apres interpolation temporelle AMMA'
    344344
    345       do k=1,nlev_amma
     345      DO k=1,nlev_amma
    346346         th_profamma(k)=0.
    347347         q_profamma(k)=0.
    … …  
    365365!Calcul des gradients verticaux
    366366!initialisation
    367       do l=1,llm
     367      DO l=1,llm
    368368      d_t_z(l)=0.
    369369      d_q_z(l)=0.
    … …  
    380380
    381381
    382       do l = 1, llm
     382      DO l = 1, llm
    383383       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
    384384       omega(l) = w_mod(l)*(-rg*rho(l))
    … …  
    414414       CALL lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
    415415
    416         do l=1,llm
     416        DO l=1,llm
    417417       d_t_adv(l) =  (dth_rico(l) +  dt_dyn(l))
    418418       d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
    … …  
    446446
    447447! Advective forcings are given in K or g/kg ... BY HOUR
    448       do l = 1, llm
     448      DO l = 1, llm
    449449       ug(l)= u_mod(l)
    450450       vg(l)= v_mod(l)
    … …  
    539539      tsurf = ts_prof
    540540      WRITE(*,*) 'SST suivante: ',tsurf
    541       do l = 1, llm
     541      DO l = 1, llm
    542542       omega(l) = omega_mod(l)
    543543       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
    … …  
    620620      tsurf = ts_prof
    621621      WRITE(*,*) 'SST suivante: ',tsurf
    622       do l = 1, llm
     622      DO l = 1, llm
    623623       omega(l) = w_mod(l)
    624624       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
    … …  
    715715!wind nudging
    716716      IF (nudge_u.gt.0.) THEN
    717         do l=1,llm
     717        DO l=1,llm
    718718           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
    719719        enddo
    720720      else
    721         do l=1,llm
     721        DO l=1,llm
    722722        u(l) = u_mod_cas(l)
    723723        enddo
    … …  
    725725
    726726      IF (nudge_v.gt.0.) THEN
    727         do l=1,llm
     727        DO l=1,llm
    728728           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
    729729        enddo
    730730      else
    731         do l=1,llm
     731        DO l=1,llm
    732732        v(l) = v_mod_cas(l)
    733733        enddo
    … …  
    735735
    736736      IF (nudge_w.gt.0.) THEN
    737         do l=1,llm
     737        DO l=1,llm
    738738           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
    739739        enddo
    740740      else
    741         do l=1,llm
     741        DO l=1,llm
    742742        w(l) = w_mod_cas(l)
    743743        enddo
    … …  
    746746!nudging of q and temp
    747747      IF (nudge_t.gt.0.) THEN
    748         do l=1,llm
     748        DO l=1,llm
    749749           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
    750750        enddo
    751751      endif
    752752      IF (nudge_q.gt.0.) THEN
    753         do l=1,llm
     753        DO l=1,llm
    754754           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
    755755        enddo
    756756      endif
    757757
    758       do l = 1, llm
     758      DO l = 1, llm
    759759       omega(l) = w_mod_cas(l)  ! juste car w_mod_cas en Pa/s (MPL 20170310)
    760760       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
    … …  
    905905!geostrophic wind
    906906      IF (forc_geo.EQ.1) THEN
    907         do l=1,llm
     907        DO l=1,llm
    908908        ug(l) = ug_mod_cas(l)
    909909        vg(l) = vg_mod_cas(l)
    … …  
    912912!wind nudging
    913913      IF (nudging_u.gt.0.) THEN
    914         do l=1,llm
     914        DO l=1,llm
    915915           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
    916916        enddo
    … …  
    922922
    923923      IF (nudging_v.gt.0.) THEN
    924         do l=1,llm
     924        DO l=1,llm
    925925           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
    926926        enddo
    … …  
    932932
    933933      IF (nudging_w.gt.0.) THEN
    934         do l=1,llm
     934        DO l=1,llm
    935935           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
    936936        enddo
    … …  
    943943!nudging of q and temp
    944944      IF (nudging_t.gt.0.) THEN
    945         do l=1,llm
     945        DO l=1,llm
    946946           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
    947947        enddo
    948948      endif
    949949      IF (nudging_qv.gt.0.) THEN
    950         do l=1,llm
     950        DO l=1,llm
    951951           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
    952952        enddo
    953953      endif
    954954
    955       do l = 1, llm
     955      DO l = 1, llm
    956956! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
    957957       omega(l) = omega_mod_cas(l)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h

    r5117 r5158  
    3939! compute altitudes of play levels.
    4040      zlay(1) =zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
    41       do l = 2,llm
     41      DO l = 2,llm
    4242        zlay(l) = zlay(l-1)+rd*tsurf*(psurf-play(1))/(rg*psurf)
    4343      enddo
    … …  
    4848!----------------------------------------------------------------------
    4949      zlay(1) = zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
    50       do l=1,llm
     50      DO l=1,llm
    5151        ! Above the max altutide of the input file
    5252
    … …  
    7474        dq_dyn(l,1) = dqtdtls(kmax)-frac*(dqtdtls(kmax)-dqtdtls(kmax-1))
    7575        dt_cooling(l)=thlpcar(kmax)-frac*(thlpcar(kmax)-thlpcar(kmax-1))
    76         do k=2,kmax
     76        DO k=2,kmax
    7777          print *,'k l height(k) height(k-1) zlay(l) frac=',k,l,height(k),height(k-1),zlay(l),frac
    7878          frac = (height(k)-zlay(l))/(height(k)-height(k-1))
    … …  
    167167       mxcalc=llm
    168168       print *, airefi, ' airefi '
    169        do l = 1, llm
     169       DO l = 1, llm
    170170       rho(l)  = play(l)/(rd*t_rico(l)*(1.+(rv/rd-1.)*q_rico(l)))
    171171       temp(l) = t_rico(l)
    … …  
    214214      tsurf = ts_prof
    215215      WRITE(*,*) 'SST initiale: ',tsurf
    216       do l = 1, llm
     216      DO l = 1, llm
    217217       temp(l) = t_mod(l)
    218218       q(l,1) = q_mod(l)
    … …  
    266266!      tsurf = ts_proftwp
    267267      WRITE(*,*) 'SST initiale: ',tsurf
    268       do l = 1, llm
     268      DO l = 1, llm
    269269       temp(l) = t_mod(l)
    270270       q(l,1) = q_mod(l)
    … …  
    296296
    297297!champs initiaux:
    298       do k=1,nlev_amma
     298      DO k=1,nlev_amma
    299299         th_ammai(k)=th_amma(k)
    300300         q_ammai(k)=q_amma(k)
    … …  
    322322!      tsurf = ts_proftwp
    323323      WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
    324       do l = 1, llm
     324      DO l = 1, llm
    325325! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
    326326!      temp(l) = t_mod(l)*(play(l)/pzero)**rkappa
    … …  
    372372
    373373!champs initiaux:
    374       do k=1,nlev_dice
     374      DO k=1,nlev_dice
    375375         t_dicei(k)=t_dice(k)
    376376         qv_dicei(k)=qv_dice(k)
    … …  
    420420! initial and boundary conditions :
    421421      WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
    422       do l = 1, llm
     422      DO l = 1, llm
    423423! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
    424424!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa
    … …  
    480480      fich_gabls4='gabls4_driver.nc'
    481481     
    482        
     482
    483483      CALL read_gabls4(fich_gabls4,nlev_gabls4,nt_gabls4,nsol_gabls4,zz_gabls4,depth_sn_gabls4,ug_gabls4,vg_gabls4 &
    484484     & ,plev_gabls4,th_gabls4,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,ht_gabls4,hq_gabls4,tg_gabls4,tsnow_gabls4,snow_dens_gabls4)
    … …  
    487487
    488488!champs initiaux:
    489       do k=1,nlev_gabls4
     489      DO k=1,nlev_gabls4
    490490         t_gabi(k)=t_gabls4(k)
    491491         qv_gabi(k)=qv_gabls4(k)
    … …  
    527527! initial and boundary conditions :
    528528      WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
    529       do l = 1, llm
     529      DO l = 1, llm
    530530! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
    531531!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa
    … …  
    539539       vg(l)=vg_mod(l)
    540540
    541 !       tg=tsurf
     541!    tg=tsurf
    542542
    543543       print *,'***** tsurf=',tsurf
    … …  
    637637! tsurf read in lmdz1d.def
    638638      WRITE(*,*) 'Tsurf initiale: ',tsurf
    639       do l = 1, llm
     639      DO l = 1, llm
    640640       play(l)=play_mod(l)*100.
    641641       presnivs(l)=play(l)
    … …  
    670670! plev at half levels is given in proh.inp.19 or proh.inp.40 files
    671671      plev(1)= ap(llm+1)+bp(llm+1)*psurf
    672       do l = 1, llm
     672      DO l = 1, llm
    673673      plev(l+1) = ap(llm-l+1)+bp(llm-l+1)*psurf
    674674      print *,'Read_forc: l height play plev zlay temp',                    &
    … …  
    733733      tsurf = ts_prof
    734734      WRITE(*,*) 'SST initiale: ',tsurf
    735       do l = 1, llm
     735      DO l = 1, llm
    736736       temp(l) = t_mod(l)
    737737       tetal(l)=thl_mod(l)
    … …  
    809809      tsurf = ts_prof
    810810      WRITE(*,*) 'SST initiale: ',tsurf
    811       do l = 1, llm
     811      DO l = 1, llm
    812812       temp(l) = t_mod(l)
    813813       tetal(l)=thl_mod(l)
    … …  
    873873      psurf=plev_prof_cas(1)
    874874      WRITE(*,*) 'SST initiale: ',tsurf
    875       do l = 1, llm
     875      DO l = 1, llm
    876876       temp(l) = t_mod_cas(l)
    877877       q(l,1) = q_mod_cas(l)
    … …  
    934934     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
    935935
    936       do l = 1, nlev_cas
     936      DO l = 1, nlev_cas
    937937      print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
    938938      enddo
    … …  
    962962      psurf=plev_prof_cas(1)
    963963      WRITE(*,*) 'SST initiale: ',tsurf
    964       do l = 1, llm
     964      DO l = 1, llm
    965965       temp(l) = t_mod_cas(l)
    966966       q(l,1) = qv_mod_cas(l)
    … …  
    10321032     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
    10331033
    1034       do l = 1, nlev_cas
     1034      DO l = 1, nlev_cas
    10351035      print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
    10361036      enddo
    … …  
    10611061      psurf=plev_prof_cas(1)
    10621062      WRITE(*,*) 'SST initiale: ',tsurf
    1063       do l = 1, llm
     1063      DO l = 1, llm
    10641064       temp(l) = t_mod_cas(l)
    10651065       q(l,1) = qv_mod_cas(l)
Note: See TracChangeset for help on using the changeset viewer.