Ignore:
Timestamp:
Mar 29, 2023, 3:14:27 PM (2 years ago)
Author:
lguez
Message:

Sync latest trunk changes to branch LMDZ_ECRad

Location:
LMDZ6/branches/LMDZ_ECRad
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ_ECRad

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/1DUTILS.h

    r4046 r4482  
    17081708
    17091709!
    1710         print *,'dtime, tau ',dtime,tau
    1711         print *, 'u_targ',u_targ
    1712         print *, 'v_targ',v_targ
    1713         print *,'zonal velocity ',u
    1714         print *,'meridional velocity ',v
     1710        !print *,'dtime, tau ',dtime,tau
     1711        !print *, 'u_targ',u_targ
     1712        !print *, 'v_targ',v_targ
     1713        !print *,'zonal velocity ',u
     1714        !print *,'meridional velocity ',v
    17151715        DO k = 1,klev
    17161716         DO i = 1,klon
    … …  
    17211721            d_v(i,k) = d_v(i,k) + 1./tau*(v_targ(i,k)-v(i,k))
    17221722!
    1723             print *,' k,u,d_u,v,d_v ',    &
    1724                       k,u(i,k),d_u(i,k),v(i,k),d_v(i,k)
     1723!           print *,' k,u,d_u,v,d_v ',    &
     1724!                     k,u(i,k),d_u(i,k),v(i,k),d_v(i,k)
    17251725!           ENDIF
    17261726!

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

    r4104 r4482  
    1010!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
    1111     &       ,nt_cas,nlev_cas                                                               &
    12      &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
     12     &       ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
    1313     &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
    1414     &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
    … …  
    1919     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    2020!
    21      &       ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
     21     &       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    2222     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    2323     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
    … …  
    3131     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    3232! EV tg instead of ts_cur
    33              tg = ts_prof_cas
     33             tg = ts_prof_cas
     34             if ((tg .eq. 0.) .and. (tskin_prof_cas .ne. 0.)) then
     35                tg=tskin_prof_cas
     36              endif
     37
    3438!            psurf=plev_prof_cas(1)
    3539             psurf=ps_prof_cas

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

    r4104 r4482  
    2424!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
    2525     &       ,nt_cas,nlev_cas                                                               &
    26      &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
     26     &       ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
    2727     &       ,u_cas,v_cas,ug_cas,vg_cas                                                     &
    2828     &       ,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas                               &
    … …  
    3333     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    3434!
    35      &       ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
     35     &       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
    3636     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    3737     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
    … …  
    7373
    7474! initial and boundary conditions :
    75 !     tsurf = ts_prof_cas
    7675      psurf = ps_prof_cas
    77       !EV tg instead of ts_cur
    78       tg = ts_prof_cas
    79       print*, 'tg=', tg
     76      if (tskin_prof_cas .NE. 0.) THEN
     77          tsurf=tskin_prof_cas
     78      endif
     79
     80      tg = ts_prof_cas
     81      if ((tg .eq. 0.) .and. (tskin_prof_cas .NE. 0.)) THEN
     82          tg=tskin_prof_cas
     83      endif
     84
     85
    8086
    8187      do l = 1, llm
    … …  
    8389       q(l,1) = qv_mod_cas(l)
    8490       q(l,2) = ql_mod_cas(l)
     91       q(l,3) = qi_mod_cas(l)
    8592       u(l) = u_mod_cas(l)
    8693       ug(l)= ug_mod_cas(l)

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

    r4104 r4482  
    55
    66!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    7 !Declarations specifiques au cas standard
    8         character*80 :: fich_cas
    9 ! Discr?tisation
    10         integer nlev_cas, nt_cas
    11 
    12 
    13 !profils environnementaux
    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(:,:)
    21 
    22 !forcing
    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(:)
    32 
    33 !champs interpoles
    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 
    73         real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
    74         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
    75      
     7  !Declarations specifiques au cas standard
     8  character*80 :: fich_cas
     9  ! Discr?tisation
     10  integer nlev_cas, nt_cas
     11
     12
     13  !profils environnementaux
     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(:,:)
     21
     22  !forcing
     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(:)
     32
     33  !champs interpoles
     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
     73  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
     74  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
     75
    7676
    7777
    7878CONTAINS
    7979
    80 SUBROUTINE read_1D_cas
    81       implicit none
     80  SUBROUTINE read_1D_cas
     81    implicit none
    8282
    8383#include "netcdf.inc"
    8484
    85       INTEGER nid,rid,ierr
    86       INTEGER ii,jj
    87 
    88       fich_cas='setup/cas.nc'
    89       print*,'fich_cas ',fich_cas
    90       ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    91       print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    92       if (ierr.NE.NF_NOERR) then
    93          write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    94          write(*,*) NF_STRERROR(ierr)
    95          stop ""
    96       endif
    97 !.......................................................................
    98       ierr=NF_INQ_DIMID(nid,'lat',rid)
    99       IF (ierr.NE.NF_NOERR) THEN
    100          print*, 'Oh probleme lecture dimension lat'
    101       ENDIF
    102       ierr=NF_INQ_DIMLEN(nid,rid,ii)
    103       print*,'OK1 nid,rid,lat',nid,rid,ii
    104 !.......................................................................
    105       ierr=NF_INQ_DIMID(nid,'lon',rid)
    106       IF (ierr.NE.NF_NOERR) THEN
    107          print*, 'Oh probleme lecture dimension lon'
    108       ENDIF
    109       ierr=NF_INQ_DIMLEN(nid,rid,jj)
    110       print*,'OK2 nid,rid,lat',nid,rid,jj
    111 !.......................................................................
    112       ierr=NF_INQ_DIMID(nid,'lev',rid)
    113       IF (ierr.NE.NF_NOERR) THEN
    114          print*, 'Oh probleme lecture dimension zz'
    115       ENDIF
    116       ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
    117       print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
    118 !.......................................................................
    119       ierr=NF_INQ_DIMID(nid,'time',rid)
    120       print*,'nid,rid',nid,rid
    121       nt_cas=0
    122       IF (ierr.NE.NF_NOERR) THEN
    123         stop 'probleme lecture dimension sens'
    124       ENDIF
    125       ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
    126       print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
     85    INTEGER nid,rid,ierr
     86    INTEGER ii,jj
     87
     88    fich_cas='setup/cas.nc'
     89    print*,'fich_cas ',fich_cas
     90    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
     91    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
     92    if (ierr.NE.NF_NOERR) then
     93       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
     94       write(*,*) NF_STRERROR(ierr)
     95       stop ""
     96    endif
     97    !.......................................................................
     98    ierr=NF_INQ_DIMID(nid,'lat',rid)
     99    IF (ierr.NE.NF_NOERR) THEN
     100       print*, 'Oh probleme lecture dimension lat'
     101    ENDIF
     102    ierr=NF_INQ_DIMLEN(nid,rid,ii)
     103    print*,'OK1 nid,rid,lat',nid,rid,ii
     104    !.......................................................................
     105    ierr=NF_INQ_DIMID(nid,'lon',rid)
     106    IF (ierr.NE.NF_NOERR) THEN
     107       print*, 'Oh probleme lecture dimension lon'
     108    ENDIF
     109    ierr=NF_INQ_DIMLEN(nid,rid,jj)
     110    print*,'OK2 nid,rid,lat',nid,rid,jj
     111    !.......................................................................
     112    ierr=NF_INQ_DIMID(nid,'lev',rid)
     113    IF (ierr.NE.NF_NOERR) THEN
     114       print*, 'Oh probleme lecture dimension zz'
     115    ENDIF
     116    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
     117    print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
     118    !.......................................................................
     119    ierr=NF_INQ_DIMID(nid,'time',rid)
     120    print*,'nid,rid',nid,rid
     121    nt_cas=0
     122    IF (ierr.NE.NF_NOERR) THEN
     123       stop 'probleme lecture dimension sens'
     124    ENDIF
     125    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
     126    print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
    127127
    128128!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    129 !profils moyens:
    130         allocate(plev_cas(nlev_cas,nt_cas))       
    131         allocate(z_cas(nlev_cas,nt_cas))
    132         allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    133         allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
    134         allocate(u_cas(nlev_cas,nt_cas))
    135         allocate(v_cas(nlev_cas,nt_cas))
    136 
    137 !forcing
    138         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))
    139         allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    140         allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    141         allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    142         allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    143         allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    144         allocate(vitw_cas(nlev_cas,nt_cas))
    145         allocate(ug_cas(nlev_cas,nt_cas))
    146         allocate(vg_cas(nlev_cas,nt_cas))
    147         allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas))
    148         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))
    149 
    150 
    151 !champs interpoles
    152         allocate(plev_prof_cas(nlev_cas))
    153         allocate(t_prof_cas(nlev_cas))
    154         allocate(q_prof_cas(nlev_cas))
    155         allocate(u_prof_cas(nlev_cas))
    156         allocate(v_prof_cas(nlev_cas))
    157 
    158         allocate(vitw_prof_cas(nlev_cas))
    159         allocate(ug_prof_cas(nlev_cas))
    160         allocate(vg_prof_cas(nlev_cas))
    161         allocate(ht_prof_cas(nlev_cas))
    162         allocate(hq_prof_cas(nlev_cas))
    163         allocate(hu_prof_cas(nlev_cas))
    164         allocate(hv_prof_cas(nlev_cas))
    165         allocate(vt_prof_cas(nlev_cas))
    166         allocate(vq_prof_cas(nlev_cas))
    167         allocate(vu_prof_cas(nlev_cas))
    168         allocate(vv_prof_cas(nlev_cas))
    169         allocate(dt_prof_cas(nlev_cas))
    170         allocate(dtrad_prof_cas(nlev_cas))
    171         allocate(dq_prof_cas(nlev_cas))
    172         allocate(du_prof_cas(nlev_cas))
    173         allocate(dv_prof_cas(nlev_cas))
    174         allocate(uw_prof_cas(nlev_cas))
    175         allocate(vw_prof_cas(nlev_cas))
    176         allocate(q1_prof_cas(nlev_cas))
    177         allocate(q2_prof_cas(nlev_cas))
    178 
    179         print*,'Allocations OK'
    180         call read_cas2(nid,nlev_cas,nt_cas                                       &
    181      &     ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
    182      &     ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
    183      &     ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
    184      &     ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
    185      &     ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    186         print*,'Read cas OK'
    187 
    188 
    189 END SUBROUTINE read_1D_cas
    190 !**********************************************************************************************
    191 SUBROUTINE read2_1D_cas
    192       implicit none
     129    !profils moyens:
     130    allocate(plev_cas(nlev_cas,nt_cas))       
     131    allocate(z_cas(nlev_cas,nt_cas))
     132    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
     133    allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
     134    allocate(u_cas(nlev_cas,nt_cas))
     135    allocate(v_cas(nlev_cas,nt_cas))
     136
     137    !forcing
     138    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))
     139    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
     140    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
     141    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
     142    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
     143    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
     144    allocate(vitw_cas(nlev_cas,nt_cas))
     145    allocate(ug_cas(nlev_cas,nt_cas))
     146    allocate(vg_cas(nlev_cas,nt_cas))
     147    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas))
     148    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))
     149
     150
     151    !champs interpoles
     152    allocate(plev_prof_cas(nlev_cas))
     153    allocate(t_prof_cas(nlev_cas))
     154    allocate(q_prof_cas(nlev_cas))
     155    allocate(u_prof_cas(nlev_cas))
     156    allocate(v_prof_cas(nlev_cas))
     157
     158    allocate(vitw_prof_cas(nlev_cas))
     159    allocate(ug_prof_cas(nlev_cas))
     160    allocate(vg_prof_cas(nlev_cas))
     161    allocate(ht_prof_cas(nlev_cas))
     162    allocate(hq_prof_cas(nlev_cas))
     163    allocate(hu_prof_cas(nlev_cas))
     164    allocate(hv_prof_cas(nlev_cas))
     165    allocate(vt_prof_cas(nlev_cas))
     166    allocate(vq_prof_cas(nlev_cas))
     167    allocate(vu_prof_cas(nlev_cas))
     168    allocate(vv_prof_cas(nlev_cas))
     169    allocate(dt_prof_cas(nlev_cas))
     170    allocate(dtrad_prof_cas(nlev_cas))
     171    allocate(dq_prof_cas(nlev_cas))
     172    allocate(du_prof_cas(nlev_cas))
     173    allocate(dv_prof_cas(nlev_cas))
     174    allocate(uw_prof_cas(nlev_cas))
     175    allocate(vw_prof_cas(nlev_cas))
     176    allocate(q1_prof_cas(nlev_cas))
     177    allocate(q2_prof_cas(nlev_cas))
     178
     179    print*,'Allocations OK'
     180    call read_cas2(nid,nlev_cas,nt_cas                                       &
     181         ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
     182         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
     183         ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
     184         ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
     185         ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
     186    print*,'Read cas OK'
     187
     188
     189  END SUBROUTINE read_1D_cas
     190  !**********************************************************************************************
     191  SUBROUTINE read2_1D_cas
     192    implicit none
    193193
    194194#include "netcdf.inc"
    195195
    196       INTEGER nid,rid,ierr
    197       INTEGER ii,jj
    198 
    199       fich_cas='setup/cas.nc'
    200       print*,'fich_cas ',fich_cas
    201       ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    202       print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    203       if (ierr.NE.NF_NOERR) then
    204          write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    205          write(*,*) NF_STRERROR(ierr)
    206          stop ""
    207       endif
    208 !.......................................................................
    209       ierr=NF_INQ_DIMID(nid,'lat',rid)
    210       IF (ierr.NE.NF_NOERR) THEN
    211          print*, 'Oh probleme lecture dimension lat'
    212       ENDIF
    213       ierr=NF_INQ_DIMLEN(nid,rid,ii)
    214       print*,'OK1 read2: nid,rid,lat',nid,rid,ii
    215 !.......................................................................
    216       ierr=NF_INQ_DIMID(nid,'lon',rid)
    217       IF (ierr.NE.NF_NOERR) THEN
    218          print*, 'Oh probleme lecture dimension lon'
    219       ENDIF
    220       ierr=NF_INQ_DIMLEN(nid,rid,jj)
    221       print*,'OK2 read2: nid,rid,lat',nid,rid,jj
    222 !.......................................................................
    223       ierr=NF_INQ_DIMID(nid,'nlev',rid)
    224       IF (ierr.NE.NF_NOERR) THEN
    225          print*, 'Oh probleme lecture dimension nlev'
    226       ENDIF
    227       ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
    228       print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
    229 !.......................................................................
    230       ierr=NF_INQ_DIMID(nid,'time',rid)
    231       nt_cas=0
    232       IF (ierr.NE.NF_NOERR) THEN
    233         stop 'Oh probleme lecture dimension time'
    234       ENDIF
    235       ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
    236       print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
     196    INTEGER nid,rid,ierr
     197    INTEGER ii,jj
     198
     199    fich_cas='setup/cas.nc'
     200    print*,'fich_cas ',fich_cas
     201    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
     202    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
     203    if (ierr.NE.NF_NOERR) then
     204       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
     205       write(*,*) NF_STRERROR(ierr)
     206       stop ""
     207    endif
     208    !.......................................................................
     209    ierr=NF_INQ_DIMID(nid,'lat',rid)
     210    IF (ierr.NE.NF_NOERR) THEN
     211       print*, 'Oh probleme lecture dimension lat'
     212    ENDIF
     213    ierr=NF_INQ_DIMLEN(nid,rid,ii)
     214    print*,'OK1 read2: nid,rid,lat',nid,rid,ii
     215    !.......................................................................
     216    ierr=NF_INQ_DIMID(nid,'lon',rid)
     217    IF (ierr.NE.NF_NOERR) THEN
     218       print*, 'Oh probleme lecture dimension lon'
     219    ENDIF
     220    ierr=NF_INQ_DIMLEN(nid,rid,jj)
     221    print*,'OK2 read2: nid,rid,lat',nid,rid,jj
     222    !.......................................................................
     223    ierr=NF_INQ_DIMID(nid,'nlev',rid)
     224    IF (ierr.NE.NF_NOERR) THEN
     225       print*, 'Oh probleme lecture dimension nlev'
     226    ENDIF
     227    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
     228    print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
     229    !.......................................................................
     230    ierr=NF_INQ_DIMID(nid,'time',rid)
     231    nt_cas=0
     232    IF (ierr.NE.NF_NOERR) THEN
     233       stop 'Oh probleme lecture dimension time'
     234    ENDIF
     235    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
     236    print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
    237237
    238238!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    239 !profils moyens:
    240         allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    241         allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    242         allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
    243         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), &
    244              qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    245         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))
    246         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))
    247 
    248 !forcing
    249         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))
    250         allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    251         allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    252         allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    253         allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    254         allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    255         allocate(ug_cas(nlev_cas,nt_cas))
    256         allocate(vg_cas(nlev_cas,nt_cas))
    257         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))
    258         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))
    259 
    260 
    261 
    262 !champs interpoles
    263         allocate(plev_prof_cas(nlev_cas))
    264         allocate(t_prof_cas(nlev_cas))
    265         allocate(theta_prof_cas(nlev_cas))
    266         allocate(thl_prof_cas(nlev_cas))
    267         allocate(thv_prof_cas(nlev_cas))
    268         allocate(q_prof_cas(nlev_cas))
    269         allocate(qv_prof_cas(nlev_cas))
    270         allocate(ql_prof_cas(nlev_cas))
    271         allocate(qi_prof_cas(nlev_cas))
    272         allocate(rh_prof_cas(nlev_cas))
    273         allocate(rv_prof_cas(nlev_cas))
    274         allocate(u_prof_cas(nlev_cas))
    275         allocate(v_prof_cas(nlev_cas))
    276         allocate(vitw_prof_cas(nlev_cas))
    277         allocate(omega_prof_cas(nlev_cas))
    278         allocate(ug_prof_cas(nlev_cas))
    279         allocate(vg_prof_cas(nlev_cas))
    280         allocate(ht_prof_cas(nlev_cas))
    281         allocate(hth_prof_cas(nlev_cas))
    282         allocate(hq_prof_cas(nlev_cas))
    283         allocate(hu_prof_cas(nlev_cas))
    284         allocate(hv_prof_cas(nlev_cas))
    285         allocate(vt_prof_cas(nlev_cas))
    286         allocate(vth_prof_cas(nlev_cas))
    287         allocate(vq_prof_cas(nlev_cas))
    288         allocate(vu_prof_cas(nlev_cas))
    289         allocate(vv_prof_cas(nlev_cas))
    290         allocate(dt_prof_cas(nlev_cas))
    291         allocate(dth_prof_cas(nlev_cas))
    292         allocate(dtrad_prof_cas(nlev_cas))
    293         allocate(dq_prof_cas(nlev_cas))
    294         allocate(du_prof_cas(nlev_cas))
    295         allocate(dv_prof_cas(nlev_cas))
    296         allocate(uw_prof_cas(nlev_cas))
    297         allocate(vw_prof_cas(nlev_cas))
    298         allocate(q1_prof_cas(nlev_cas))
    299         allocate(q2_prof_cas(nlev_cas))
    300 
    301         print*,'Allocations OK'
    302         call read2_cas (nid,nlev_cas,nt_cas,                                                                     &
    303      &     ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
    304      &     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,        &
    305      &     dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
    306      &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
    307      &     uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
    308      &     o3_cas,rugos_cas,clay_cas,sand_cas)
    309         print*,'Read2 cas OK'
    310         do ii=1,nlev_cas
    311         print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
    312         enddo
    313 
    314 
    315 END SUBROUTINE read2_1D_cas
    316 
    317 !**********************************************************************************************
    318 SUBROUTINE old_read_SCM_cas
    319       implicit none
     239    !profils moyens:
     240    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
     241    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
     242    allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
     243    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), &
     244         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
     245    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))
     246    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))
     247
     248    !forcing
     249    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))
     250    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
     251    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
     252    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
     253    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
     254    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
     255    allocate(ug_cas(nlev_cas,nt_cas))
     256    allocate(vg_cas(nlev_cas,nt_cas))
     257    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))
     258    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))
     259
     260
     261
     262    !champs interpoles
     263    allocate(plev_prof_cas(nlev_cas))
     264    allocate(t_prof_cas(nlev_cas))
     265    allocate(theta_prof_cas(nlev_cas))
     266    allocate(thl_prof_cas(nlev_cas))
     267    allocate(thv_prof_cas(nlev_cas))
     268    allocate(q_prof_cas(nlev_cas))
     269    allocate(qv_prof_cas(nlev_cas))
     270    allocate(ql_prof_cas(nlev_cas))
     271    allocate(qi_prof_cas(nlev_cas))
     272    allocate(rh_prof_cas(nlev_cas))
     273    allocate(rv_prof_cas(nlev_cas))
     274    allocate(u_prof_cas(nlev_cas))
     275    allocate(v_prof_cas(nlev_cas))
     276    allocate(vitw_prof_cas(nlev_cas))
     277    allocate(omega_prof_cas(nlev_cas))
     278    allocate(ug_prof_cas(nlev_cas))
     279    allocate(vg_prof_cas(nlev_cas))
     280    allocate(ht_prof_cas(nlev_cas))
     281    allocate(hth_prof_cas(nlev_cas))
     282    allocate(hq_prof_cas(nlev_cas))
     283    allocate(hu_prof_cas(nlev_cas))
     284    allocate(hv_prof_cas(nlev_cas))
     285    allocate(vt_prof_cas(nlev_cas))
     286    allocate(vth_prof_cas(nlev_cas))
     287    allocate(vq_prof_cas(nlev_cas))
     288    allocate(vu_prof_cas(nlev_cas))
     289    allocate(vv_prof_cas(nlev_cas))
     290    allocate(dt_prof_cas(nlev_cas))
     291    allocate(dth_prof_cas(nlev_cas))
     292    allocate(dtrad_prof_cas(nlev_cas))
     293    allocate(dq_prof_cas(nlev_cas))
     294    allocate(du_prof_cas(nlev_cas))
     295    allocate(dv_prof_cas(nlev_cas))
     296    allocate(uw_prof_cas(nlev_cas))
     297    allocate(vw_prof_cas(nlev_cas))
     298    allocate(q1_prof_cas(nlev_cas))
     299    allocate(q2_prof_cas(nlev_cas))
     300
     301    print*,'Allocations OK'
     302    call read2_cas (nid,nlev_cas,nt_cas,                                                                     &
     303         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
     304         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,        &
     305         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
     306         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
     307         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
     308         o3_cas,rugos_cas,clay_cas,sand_cas)
     309    print*,'Read2 cas OK'
     310    do ii=1,nlev_cas
     311       print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
     312    enddo
     313
     314
     315  END SUBROUTINE read2_1D_cas
     316
     317  !**********************************************************************************************
     318  SUBROUTINE old_read_SCM_cas
     319    use netcdf, only: nf90_get_var
     320    implicit none
    320321
    321322#include "netcdf.inc"
    322323#include "date_cas.h"
    323324
    324       INTEGER nid,rid,ierr
    325       INTEGER ii,jj,timeid
    326       REAL, ALLOCATABLE :: time_val(:)
    327 
    328       fich_cas='cas.nc'
    329       print*,'fich_cas ',fich_cas
    330       ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    331       print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    332       if (ierr.NE.NF_NOERR) then
    333          write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    334          write(*,*) NF_STRERROR(ierr)
    335          stop ""
    336       endif
    337 !.......................................................................
    338       ierr=NF_INQ_DIMID(nid,'lat',rid)
    339       IF (ierr.NE.NF_NOERR) THEN
    340          print*, 'Oh probleme lecture dimension lat'
    341       ENDIF
    342       ierr=NF_INQ_DIMLEN(nid,rid,ii)
    343       print*,'OK1 read2: nid,rid,lat',nid,rid,ii
    344 !.......................................................................
    345       ierr=NF_INQ_DIMID(nid,'lon',rid)
    346       IF (ierr.NE.NF_NOERR) THEN
    347          print*, 'Oh probleme lecture dimension lon'
    348       ENDIF
    349       ierr=NF_INQ_DIMLEN(nid,rid,jj)
    350       print*,'OK2 read2: nid,rid,lat',nid,rid,jj
    351 !.......................................................................
    352       ierr=NF_INQ_DIMID(nid,'lev',rid)
    353       IF (ierr.NE.NF_NOERR) THEN
    354          print*, 'Oh probleme lecture dimension nlev'
    355       ENDIF
    356       ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
    357       print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
    358       IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN
    359               print*,'Valeur de nlev_cas peu probable'
    360               STOP
    361       ENDIF
    362 !.......................................................................
    363       ierr=NF_INQ_DIMID(nid,'time',rid)
    364       nt_cas=0
    365       IF (ierr.NE.NF_NOERR) THEN
    366         stop 'Oh probleme lecture dimension time'
    367       ENDIF
    368       ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
    369       print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
    370 ! Lecture de l'axe des temps
    371       print*,'LECTURE DU TEMPS'
    372       ierr=NF_INQ_VARID(nid,'time',timeid)
    373          if(ierr/=NF_NOERR) then
    374            print *,'Variable time manquante dans cas.nc:'
    375            ierr=NF_NOERR
    376          else
    377                  allocate(time_val(nt_cas))
    378 #ifdef NC_DOUBLE
    379          ierr = NF_GET_VAR_DOUBLE(nid,timeid,time_val)
    380 #else
    381            ierr = NF_GET_VAR_REAL(nid,timeid,time_val)
    382 #endif
    383            if(ierr/=NF_NOERR) then
    384               print *,'Pb a la lecture de time cas.nc: '
    385            endif
    386    endif
    387    IF (nt_cas>1) THEN
    388            pdt_cas=time_val(2)-time_val(1)
    389    ELSE
    390            pdt_cas=0.
    391    ENDIF
     325    INTEGER nid,rid,ierr
     326    INTEGER ii,jj,timeid
     327    REAL, ALLOCATABLE :: time_val(:)
     328
     329    fich_cas='cas.nc'
     330    print*,'fich_cas ',fich_cas
     331    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
     332    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
     333    if (ierr.NE.NF_NOERR) then
     334       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
     335       write(*,*) NF_STRERROR(ierr)
     336       stop ""
     337    endif
     338    !.......................................................................
     339    ierr=NF_INQ_DIMID(nid,'lat',rid)
     340    IF (ierr.NE.NF_NOERR) THEN
     341       print*, 'Oh probleme lecture dimension lat'
     342    ENDIF
     343    ierr=NF_INQ_DIMLEN(nid,rid,ii)
     344    print*,'OK1 read2: nid,rid,lat',nid,rid,ii
     345    !.......................................................................
     346    ierr=NF_INQ_DIMID(nid,'lon',rid)
     347    IF (ierr.NE.NF_NOERR) THEN
     348       print*, 'Oh probleme lecture dimension lon'
     349    ENDIF
     350    ierr=NF_INQ_DIMLEN(nid,rid,jj)
     351    print*,'OK2 read2: nid,rid,lat',nid,rid,jj
     352    !.......................................................................
     353    ierr=NF_INQ_DIMID(nid,'lev',rid)
     354    IF (ierr.NE.NF_NOERR) THEN
     355       print*, 'Oh probleme lecture dimension nlev'
     356    ENDIF
     357    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
     358    print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
     359    IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN
     360       print*,'Valeur de nlev_cas peu probable'
     361       STOP
     362    ENDIF
     363    !.......................................................................
     364    ierr=NF_INQ_DIMID(nid,'time',rid)
     365    nt_cas=0
     366    IF (ierr.NE.NF_NOERR) THEN
     367       stop 'Oh probleme lecture dimension time'
     368    ENDIF
     369    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
     370    print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
     371    ! Lecture de l'axe des temps
     372    print*,'LECTURE DU TEMPS'
     373    ierr=NF_INQ_VARID(nid,'time',timeid)
     374    if(ierr/=NF_NOERR) then
     375       print *,'Variable time manquante dans cas.nc:'
     376       ierr=NF_NOERR
     377    else
     378       allocate(time_val(nt_cas))
     379       ierr = NF90_GET_VAR(nid,timeid,time_val)
     380       if(ierr/=NF_NOERR) then
     381          print *,'Pb a la lecture de time cas.nc: '
     382       endif
     383    endif
     384    IF (nt_cas>1) THEN
     385       pdt_cas=time_val(2)-time_val(1)
     386    ELSE
     387       pdt_cas=0.
     388    ENDIF
    392389
    393390
    394391!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    395 !profils moyens:
    396         allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    397         allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    398         allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
    399         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), &
    400              qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    401         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))
    402         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))
    403 
    404 !forcing
    405         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))
    406         allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    407         allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    408         allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    409         allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    410         allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    411         allocate(ug_cas(nlev_cas,nt_cas))
    412         allocate(vg_cas(nlev_cas,nt_cas))
    413         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))
    414         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))
    415 
    416 
    417 
    418 !champs interpoles
    419         allocate(plev_prof_cas(nlev_cas))
    420         allocate(t_prof_cas(nlev_cas))
    421         allocate(theta_prof_cas(nlev_cas))
    422         allocate(thl_prof_cas(nlev_cas))
    423         allocate(thv_prof_cas(nlev_cas))
    424         allocate(q_prof_cas(nlev_cas))
    425         allocate(qv_prof_cas(nlev_cas))
    426         allocate(ql_prof_cas(nlev_cas))
    427         allocate(qi_prof_cas(nlev_cas))
    428         allocate(rh_prof_cas(nlev_cas))
    429         allocate(rv_prof_cas(nlev_cas))
    430         allocate(u_prof_cas(nlev_cas))
    431         allocate(v_prof_cas(nlev_cas))
    432         allocate(vitw_prof_cas(nlev_cas))
    433         allocate(omega_prof_cas(nlev_cas))
    434         allocate(ug_prof_cas(nlev_cas))
    435         allocate(vg_prof_cas(nlev_cas))
    436         allocate(ht_prof_cas(nlev_cas))
    437         allocate(hth_prof_cas(nlev_cas))
    438         allocate(hq_prof_cas(nlev_cas))
    439         allocate(hu_prof_cas(nlev_cas))
    440         allocate(hv_prof_cas(nlev_cas))
    441         allocate(vt_prof_cas(nlev_cas))
    442         allocate(vth_prof_cas(nlev_cas))
    443         allocate(vq_prof_cas(nlev_cas))
    444         allocate(vu_prof_cas(nlev_cas))
    445         allocate(vv_prof_cas(nlev_cas))
    446         allocate(dt_prof_cas(nlev_cas))
    447         allocate(dth_prof_cas(nlev_cas))
    448         allocate(dtrad_prof_cas(nlev_cas))
    449         allocate(dq_prof_cas(nlev_cas))
    450         allocate(du_prof_cas(nlev_cas))
    451         allocate(dv_prof_cas(nlev_cas))
    452         allocate(uw_prof_cas(nlev_cas))
    453         allocate(vw_prof_cas(nlev_cas))
    454         allocate(q1_prof_cas(nlev_cas))
    455         allocate(q2_prof_cas(nlev_cas))
    456 
    457         print*,'Allocations OK'
    458         call old_read_SCM (nid,nlev_cas,nt_cas,                                                                     &
    459      &     ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
    460      &     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,        &
    461      &     dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
    462      &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
    463      &     uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
    464      &     o3_cas,rugos_cas,clay_cas,sand_cas)
    465         print*,'Read2 cas OK'
    466         do ii=1,nlev_cas
    467         print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
    468         enddo
    469 
    470 
    471 END SUBROUTINE old_read_SCM_cas
     392    !profils moyens:
     393    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
     394    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
     395    allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
     396    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), &
     397         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
     398    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))
     399    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))
     400
     401    !forcing
     402    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))
     403    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
     404    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
     405    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
     406    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
     407    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
     408    allocate(ug_cas(nlev_cas,nt_cas))
     409    allocate(vg_cas(nlev_cas,nt_cas))
     410    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))
     411    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))
     412
     413
     414
     415    !champs interpoles
     416    allocate(plev_prof_cas(nlev_cas))
     417    allocate(t_prof_cas(nlev_cas))
     418    allocate(theta_prof_cas(nlev_cas))
     419    allocate(thl_prof_cas(nlev_cas))
     420    allocate(thv_prof_cas(nlev_cas))
     421    allocate(q_prof_cas(nlev_cas))
     422    allocate(qv_prof_cas(nlev_cas))
     423    allocate(ql_prof_cas(nlev_cas))
     424    allocate(qi_prof_cas(nlev_cas))
     425    allocate(rh_prof_cas(nlev_cas))
     426    allocate(rv_prof_cas(nlev_cas))
     427    allocate(u_prof_cas(nlev_cas))
     428    allocate(v_prof_cas(nlev_cas))
     429    allocate(vitw_prof_cas(nlev_cas))
     430    allocate(omega_prof_cas(nlev_cas))
     431    allocate(ug_prof_cas(nlev_cas))
     432    allocate(vg_prof_cas(nlev_cas))
     433    allocate(ht_prof_cas(nlev_cas))
     434    allocate(hth_prof_cas(nlev_cas))
     435    allocate(hq_prof_cas(nlev_cas))
     436    allocate(hu_prof_cas(nlev_cas))
     437    allocate(hv_prof_cas(nlev_cas))
     438    allocate(vt_prof_cas(nlev_cas))
     439    allocate(vth_prof_cas(nlev_cas))
     440    allocate(vq_prof_cas(nlev_cas))
     441    allocate(vu_prof_cas(nlev_cas))
     442    allocate(vv_prof_cas(nlev_cas))
     443    allocate(dt_prof_cas(nlev_cas))
     444    allocate(dth_prof_cas(nlev_cas))
     445    allocate(dtrad_prof_cas(nlev_cas))
     446    allocate(dq_prof_cas(nlev_cas))
     447    allocate(du_prof_cas(nlev_cas))
     448    allocate(dv_prof_cas(nlev_cas))
     449    allocate(uw_prof_cas(nlev_cas))
     450    allocate(vw_prof_cas(nlev_cas))
     451    allocate(q1_prof_cas(nlev_cas))
     452    allocate(q2_prof_cas(nlev_cas))
     453
     454    print*,'Allocations OK'
     455    call old_read_SCM (nid,nlev_cas,nt_cas,                                                                     &
     456         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
     457         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,        &
     458         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
     459         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
     460         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
     461         o3_cas,rugos_cas,clay_cas,sand_cas)
     462    print*,'Read2 cas OK'
     463    do ii=1,nlev_cas
     464       print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
     465    enddo
     466
     467
     468  END SUBROUTINE old_read_SCM_cas
    472469
    473470
    474471!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    475 SUBROUTINE deallocate2_1D_cases
    476 !profils environnementaux:
    477         deallocate(plev_cas,plevh_cas)
    478        
    479         deallocate(z_cas,zh_cas)
    480         deallocate(ap_cas,bp_cas)
    481         deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
    482         deallocate(th_cas,thl_cas,thv_cas,rv_cas)
    483         deallocate(u_cas,v_cas,vitw_cas,omega_cas)
    484        
    485 !forcing
    486         deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    487         deallocate(hq_cas,vq_cas,dq_cas)
    488         deallocate(hth_cas,vth_cas,dth_cas)
    489         deallocate(hr_cas,vr_cas,dr_cas)
    490         deallocate(hu_cas,vu_cas,du_cas)
    491         deallocate(hv_cas,vv_cas,dv_cas)
    492         deallocate(ug_cas)
    493         deallocate(vg_cas)
    494         deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    495 
    496 !champs interpoles
    497         deallocate(plev_prof_cas)
    498         deallocate(t_prof_cas)
    499         deallocate(theta_prof_cas)
    500         deallocate(thl_prof_cas)
    501         deallocate(thv_prof_cas)
    502         deallocate(q_prof_cas)
    503         deallocate(qv_prof_cas)
    504         deallocate(ql_prof_cas)
    505         deallocate(qi_prof_cas)
    506         deallocate(rh_prof_cas)
    507         deallocate(rv_prof_cas)
    508         deallocate(u_prof_cas)
    509         deallocate(v_prof_cas)
    510         deallocate(vitw_prof_cas)
    511         deallocate(omega_prof_cas)
    512         deallocate(ug_prof_cas)
    513         deallocate(vg_prof_cas)
    514         deallocate(ht_prof_cas)
    515         deallocate(hq_prof_cas)
    516         deallocate(hu_prof_cas)
    517         deallocate(hv_prof_cas)
    518         deallocate(vt_prof_cas)
    519         deallocate(vq_prof_cas)
    520         deallocate(vu_prof_cas)
    521         deallocate(vv_prof_cas)
    522         deallocate(dt_prof_cas)
    523         deallocate(dtrad_prof_cas)
    524         deallocate(dq_prof_cas)
    525         deallocate(du_prof_cas)
    526         deallocate(dv_prof_cas)
    527         deallocate(t_prof_cas)
    528         deallocate(u_prof_cas)
    529         deallocate(v_prof_cas)
    530         deallocate(uw_prof_cas)
    531         deallocate(vw_prof_cas)
    532         deallocate(q1_prof_cas)
    533         deallocate(q2_prof_cas)
    534 
    535 END SUBROUTINE deallocate2_1D_cases
     472  SUBROUTINE deallocate2_1D_cases
     473    !profils environnementaux:
     474    deallocate(plev_cas,plevh_cas)
     475
     476    deallocate(z_cas,zh_cas)
     477    deallocate(ap_cas,bp_cas)
     478    deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
     479    deallocate(th_cas,thl_cas,thv_cas,rv_cas)
     480    deallocate(u_cas,v_cas,vitw_cas,omega_cas)
     481
     482    !forcing
     483    deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
     484    deallocate(hq_cas,vq_cas,dq_cas)
     485    deallocate(hth_cas,vth_cas,dth_cas)
     486    deallocate(hr_cas,vr_cas,dr_cas)
     487    deallocate(hu_cas,vu_cas,du_cas)
     488    deallocate(hv_cas,vv_cas,dv_cas)
     489    deallocate(ug_cas)
     490    deallocate(vg_cas)
     491    deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
     492
     493    !champs interpoles
     494    deallocate(plev_prof_cas)
     495    deallocate(t_prof_cas)
     496    deallocate(theta_prof_cas)
     497    deallocate(thl_prof_cas)
     498    deallocate(thv_prof_cas)
     499    deallocate(q_prof_cas)
     500    deallocate(qv_prof_cas)
     501    deallocate(ql_prof_cas)
     502    deallocate(qi_prof_cas)
     503    deallocate(rh_prof_cas)
     504    deallocate(rv_prof_cas)
     505    deallocate(u_prof_cas)
     506    deallocate(v_prof_cas)
     507    deallocate(vitw_prof_cas)
     508    deallocate(omega_prof_cas)
     509    deallocate(ug_prof_cas)
     510    deallocate(vg_prof_cas)
     511    deallocate(ht_prof_cas)
     512    deallocate(hq_prof_cas)
     513    deallocate(hu_prof_cas)
     514    deallocate(hv_prof_cas)
     515    deallocate(vt_prof_cas)
     516    deallocate(vq_prof_cas)
     517    deallocate(vu_prof_cas)
     518    deallocate(vv_prof_cas)
     519    deallocate(dt_prof_cas)
     520    deallocate(dtrad_prof_cas)
     521    deallocate(dq_prof_cas)
     522    deallocate(du_prof_cas)
     523    deallocate(dv_prof_cas)
     524    deallocate(t_prof_cas)
     525    deallocate(u_prof_cas)
     526    deallocate(v_prof_cas)
     527    deallocate(uw_prof_cas)
     528    deallocate(vw_prof_cas)
     529    deallocate(q1_prof_cas)
     530    deallocate(q2_prof_cas)
     531
     532  END SUBROUTINE deallocate2_1D_cases
    536533
    537534
    538535END MODULE mod_1D_cases_read2
    539536!=====================================================================
    540       subroutine read_cas2(nid,nlevel,ntime                          &
    541      &     ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
    542      &     du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
    543      &     dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
    544 
    545 !program reading forcing of the case study
    546       implicit none
     537subroutine read_cas2(nid,nlevel,ntime                          &
     538     ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
     539     du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
     540     dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
     541
     542  !program reading forcing of the case study
     543  use netcdf, only: nf90_get_var
     544  implicit none
    547545#include "netcdf.inc"
    548546
    549       integer ntime,nlevel
    550 
    551       real zz(nlevel,ntime)
    552       real pp(nlevel,ntime)
    553       real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
    554       real theta(nlevel,ntime),rv(nlevel,ntime)
    555       real u(nlevel,ntime)
    556       real v(nlevel,ntime)
    557       real ug(nlevel,ntime)
    558       real vg(nlevel,ntime)
    559       real w(nlevel,ntime)
    560       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    561       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    562       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    563       real dtrad(nlevel,ntime)
    564       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    565       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
    566       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    567       real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
    568       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
    569 
    570 
    571       integer nid, ierr, ierr1,ierr2,rid,i
    572       integer nbvar3d
    573       parameter(nbvar3d=39)
    574       integer var3didin(nbvar3d)
    575       character*5 name_var(1:nbvar3d)
    576       data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
    577      &'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
    578      &'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/
    579 
    580        do i=1,nbvar3d
    581          print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
    582        enddo
    583        do i=1,nbvar3d
    584          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    585          print *,'ierr=',i,ierr,name_var(i),var3didin(i)
    586          if(ierr/=NF_NOERR) then
    587            print *,'Variable manquante dans cas.nc:',name_var(i)
    588          endif
    589        enddo
    590        do i=1,nbvar3d
    591          print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
    592          if(i.LE.35) then
    593 #ifdef NC_DOUBLE
    594          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    595 #else
    596          ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    597 #endif
    598          print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    599          if(ierr/=NF_NOERR) then
    600             print *,'Pb a la lecture de cas.nc: ',name_var(i)
    601             stop "getvarup"
    602          endif
    603          else
    604 #ifdef NC_DOUBLE
    605          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)
    606 #else
    607          ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)
    608 #endif
    609          print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    610          if(ierr/=NF_NOERR) then
    611             print *,'Pb a la lecture de cas.nc: ',name_var(i)
    612             stop "getvarup"
    613          endif
    614          endif
    615          select case(i)
    616            case(1) ; zz=resul
    617            case(2) ; pp=resul
    618            case(3) ; temp=resul
    619            case(4) ; qv=resul
    620            case(5) ; rh=resul
    621            case(6) ; theta=resul
    622            case(7) ; rv=resul
    623            case(8) ; u=resul
    624            case(9) ; v=resul
    625            case(10) ; ug=resul
    626            case(11) ; vg=resul
    627            case(12) ; w=resul
    628            case(13) ; du=resul
    629            case(14) ; hu=resul
    630            case(15) ; vu=resul
    631            case(16) ; dv=resul
    632            case(17) ; hv=resul
    633            case(18) ; vv=resul
    634            case(19) ; dt=resul
    635            case(20) ; ht=resul
    636            case(21) ; vt=resul
    637            case(22) ; dq=resul
    638            case(23) ; hq=resul
    639            case(24) ; vq=resul
    640            case(25) ; dth=resul
    641            case(26) ; hth=resul
    642            case(27) ; vth=resul
    643            case(28) ; dr=resul
    644            case(29) ; hr=resul
    645            case(30) ; vr=resul
    646            case(31) ; dtrad=resul
    647            case(32) ; uw=resul
    648            case(33) ; vw=resul
    649            case(34) ; q1=resul
    650            case(35) ; q2=resul
    651            case(36) ; sens=resul1
    652            case(37) ; flat=resul1
    653            case(38) ; ts=resul1
    654            case(39) ; ustar=resul1
    655          end select
    656        enddo
    657 
    658          return
    659          end subroutine read_cas2
     547  integer ntime,nlevel
     548
     549  real zz(nlevel,ntime)
     550  real pp(nlevel,ntime)
     551  real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
     552  real theta(nlevel,ntime),rv(nlevel,ntime)
     553  real u(nlevel,ntime)
     554  real v(nlevel,ntime)
     555  real ug(nlevel,ntime)
     556  real vg(nlevel,ntime)
     557  real w(nlevel,ntime)
     558  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     559  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     560  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     561  real dtrad(nlevel,ntime)
     562  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     563  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
     564  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     565  real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
     566  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
     567
     568
     569  integer nid, ierr, ierr1,ierr2,rid,i
     570  integer nbvar3d
     571  parameter(nbvar3d=39)
     572  integer var3didin(nbvar3d)
     573  character*5 name_var(1:nbvar3d)
     574  data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
     575       'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
     576       'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/
     577
     578
     579  do i=1,nbvar3d
     580     print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
     581  enddo
     582  do i=1,nbvar3d
     583     ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
     584     print *,'ierr=',i,ierr,name_var(i),var3didin(i)
     585     if(ierr/=NF_NOERR) then
     586        print *,'Variable manquante dans cas.nc:',name_var(i)
     587     endif
     588  enddo
     589  do i=1,nbvar3d
     590     print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
     591     if(i.LE.35) then
     592        ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
     593        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
     594        if(ierr/=NF_NOERR) then
     595           print *,'Pb a la lecture de cas.nc: ',name_var(i)
     596           stop "getvarup"
     597        endif
     598     else
     599        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
     600        ierr = NF90_GET_VAR(nid,var3didin(i),resul1, count = [1, 1, ntime])
     601        if(ierr/=NF_NOERR) then
     602           print *,'Pb a la lecture de cas.nc: ',name_var(i)
     603           stop "getvarup"
     604        endif
     605     endif
     606     select case(i)
     607     case(1) ; zz=resul
     608     case(2) ; pp=resul
     609     case(3) ; temp=resul
     610     case(4) ; qv=resul
     611     case(5) ; rh=resul
     612     case(6) ; theta=resul
     613     case(7) ; rv=resul
     614     case(8) ; u=resul
     615     case(9) ; v=resul
     616     case(10) ; ug=resul
     617     case(11) ; vg=resul
     618     case(12) ; w=resul
     619     case(13) ; du=resul
     620     case(14) ; hu=resul
     621     case(15) ; vu=resul
     622     case(16) ; dv=resul
     623     case(17) ; hv=resul
     624     case(18) ; vv=resul
     625     case(19) ; dt=resul
     626     case(20) ; ht=resul
     627     case(21) ; vt=resul
     628     case(22) ; dq=resul
     629     case(23) ; hq=resul
     630     case(24) ; vq=resul
     631     case(25) ; dth=resul
     632     case(26) ; hth=resul
     633     case(27) ; vth=resul
     634     case(28) ; dr=resul
     635     case(29) ; hr=resul
     636     case(30) ; vr=resul
     637     case(31) ; dtrad=resul
     638     case(32) ; uw=resul
     639     case(33) ; vw=resul
     640     case(34) ; q1=resul
     641     case(35) ; q2=resul
     642     case(36) ; sens=resul1
     643     case(37) ; flat=resul1
     644     case(38) ; ts=resul1
     645     case(39) ; ustar=resul1
     646     end select
     647  enddo
     648
     649  return
     650end subroutine read_cas2
    660651!======================================================================
    661       subroutine read2_cas(nid,nlevel,ntime,                                       &
    662      &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
    663      &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    664      &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
    665      &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    666      &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    667 
    668 !program reading forcing of the case study
    669       implicit none
     652subroutine read2_cas(nid,nlevel,ntime,                                       &
     653     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
     654     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
     655     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
     656     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
     657     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
     658
     659  !program reading forcing of the case study
     660  use netcdf, only: nf90_get_var
     661  implicit none
    670662#include "netcdf.inc"
    671663
    672       integer ntime,nlevel
    673 
    674       real ap(nlevel+1),bp(nlevel+1)
    675       real zz(nlevel,ntime),zzh(nlevel+1)
    676       real pp(nlevel,ntime),pph(nlevel+1)
    677       real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    678       real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    679       real u(nlevel,ntime),v(nlevel,ntime)
    680       real ug(nlevel,ntime),vg(nlevel,ntime)
    681       real vitw(nlevel,ntime),omega(nlevel,ntime)
    682       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    683       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    684       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    685       real dtrad(nlevel,ntime)
    686       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    687       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    688       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    689       real flat(ntime),sens(ntime),ustar(ntime)
    690       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    691       real ts(ntime),ps(ntime),tke(ntime)
    692       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
    693       real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    694 
    695 
    696       integer nid, ierr,ierr1,ierr2,rid,i
    697       integer nbvar3d
    698       parameter(nbvar3d=62)
    699       integer var3didin(nbvar3d),missing_var(nbvar3d)
    700       character*12 name_var(1:nbvar3d)
    701       data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    702      &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    703      &'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
    704      'rh',&
    705      &'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
    706      &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
    707      &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
    708       do i=1,nbvar3d
    709         missing_var(i)=0.
    710       enddo
    711 
    712 !-----------------------------------------------------------------------
    713        do i=1,nbvar3d
    714          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    715          if(ierr/=NF_NOERR) then
    716            print *,'Variable manquante dans cas.nc:',i,name_var(i)
    717            ierr=NF_NOERR
    718            missing_var(i)=1
    719          else
    720 !-----------------------------------------------------------------------
    721            if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    722 #ifdef NC_DOUBLE
    723            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)
    724 #else
    725            ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)
    726 #endif
     664  integer ntime,nlevel
     665
     666  real ap(nlevel+1),bp(nlevel+1)
     667  real zz(nlevel,ntime),zzh(nlevel+1)
     668  real pp(nlevel,ntime),pph(nlevel+1)
     669  real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
     670  real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
     671  real u(nlevel,ntime),v(nlevel,ntime)
     672  real ug(nlevel,ntime),vg(nlevel,ntime)
     673  real vitw(nlevel,ntime),omega(nlevel,ntime)
     674  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     675  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     676  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     677  real dtrad(nlevel,ntime)
     678  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     679  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
     680  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     681  real flat(ntime),sens(ntime),ustar(ntime)
     682  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     683  real ts(ntime),ps(ntime),tke(ntime)
     684  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
     685  real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
     686
     687
     688  integer nid, ierr,ierr1,ierr2,rid,i
     689  integer nbvar3d
     690  parameter(nbvar3d=62)
     691  integer var3didin(nbvar3d),missing_var(nbvar3d)
     692  character*12 name_var(1:nbvar3d)
     693  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
     694       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
     695       'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
     696       'rh',&
     697       'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
     698       'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
     699       'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
     700  do i=1,nbvar3d
     701     missing_var(i)=0.
     702  enddo
     703
     704  !-----------------------------------------------------------------------
     705  do i=1,nbvar3d
     706     ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
     707     if(ierr/=NF_NOERR) then
     708        print *,'Variable manquante dans cas.nc:',i,name_var(i)
     709        ierr=NF_NOERR
     710        missing_var(i)=1
     711     else
     712        !-----------------------------------------------------------------------
     713        if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
     714           ierr = NF90_GET_VAR(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
    727715           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    728716           if(ierr/=NF_NOERR) then
    … …  
    730718              stop "getvarup"
    731719           endif
    732 !-----------------------------------------------------------------------
    733            else if(i.gt.4.and.i.LE.45) then   ! Lecture des variables en (time,nlevel,lat,lon)
    734 #ifdef NC_DOUBLE
    735            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    736 #else
    737            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    738 #endif
     720           !-----------------------------------------------------------------------
     721        else if(i.gt.4.and.i.LE.45) then   ! Lecture des variables en (time,nlevel,lat,lon)
     722           ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    739723           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    740724           if(ierr/=NF_NOERR) then
    … …  
    742726              stop "getvarup"
    743727           endif
    744 !-----------------------------------------------------------------------
    745            else if (i.gt.45.and.i.LE.51) then   ! Lecture des variables en (time,lat,lon)
    746 #ifdef NC_DOUBLE
    747            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)
    748 #else
    749            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)
    750 #endif
     728           !-----------------------------------------------------------------------
     729        else if (i.gt.45.and.i.LE.51) then   ! Lecture des variables en (time,lat,lon)
     730           ierr = NF90_GET_VAR(nid,var3didin(i),resul2, count = [1, 1, ntime])
    751731           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    752732           if(ierr/=NF_NOERR) then
    … …  
    754734              stop "getvarup"
    755735           endif
    756 !-----------------------------------------------------------------------
    757            else     ! Lecture des constantes (lat,lon)
    758 #ifdef NC_DOUBLE
    759            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)
    760 #else
    761            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)
    762 #endif
     736           !-----------------------------------------------------------------------
     737        else     ! Lecture des constantes (lat,lon)
     738           ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
    763739           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    764740           if(ierr/=NF_NOERR) then
    … …  
    766742              stop "getvarup"
    767743           endif
    768            endif
    769          endif
    770 !-----------------------------------------------------------------------
    771          select case(i)
    772            case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    773            case(2) ; bp=apbp
    774            case(3) ; zzh=apbp
    775            case(4) ; pph=apbp
    776            case(5) ; vitw=resul    ! donnees indexees en nlevel,time
    777            case(6) ; omega=resul
    778            case(7) ; ug=resul
    779            case(8) ; vg=resul
    780            case(9) ; du=resul
    781            case(10) ; hu=resul
    782            case(11) ; vu=resul
    783            case(12) ; dv=resul
    784            case(13) ; hv=resul
    785            case(14) ; vv=resul
    786            case(15) ; dt=resul
    787            case(16) ; ht=resul
    788            case(17) ; vt=resul
    789            case(18) ; dq=resul
    790            case(19) ; hq=resul
    791            case(20) ; vq=resul
    792            case(21) ; dth=resul
    793            case(22) ; hth=resul
    794            case(23) ; vth=resul
    795            case(24) ; hthl=resul
    796            case(25) ; dr=resul
    797            case(26) ; hr=resul
    798            case(27) ; vr=resul
    799            case(28) ; dtrad=resul
    800            case(29) ; q1=resul
    801            case(30) ; q2=resul
    802            case(31) ; uw=resul
    803            case(32) ; vw=resul
    804            case(33) ; rh=resul
    805            case(34) ; zz=resul      ! donnees en time,nlevel pour profil initial
    806            case(35) ; pp=resul
    807            case(36) ; temp=resul
    808            case(37) ; theta=resul
    809            case(38) ; thv=resul
    810            case(39) ; thl=resul
    811            case(40) ; qv=resul
    812            case(41) ; ql=resul
    813            case(42) ; qi=resul
    814            case(43) ; rv=resul
    815            case(44) ; u=resul
    816            case(45) ; v=resul
    817            case(46) ; sens=resul2   ! donnees indexees en time
    818            case(47) ; flat=resul2
    819            case(48) ; ts=resul2
    820            case(49) ; ps=resul2
    821            case(50) ; ustar=resul2
    822            case(51) ; tke=resul2
    823            case(52) ; orog_cas=resul3      ! constantes
    824            case(53) ; albedo_cas=resul3
    825            case(54) ; emiss_cas=resul3
    826            case(55) ; t_skin_cas=resul3
    827            case(56) ; q_skin_cas=resul3
    828            case(57) ; mom_rough=resul3
    829            case(58) ; heat_rough=resul3
    830            case(59) ; o3_cas=resul3       
    831            case(60) ; rugos_cas=resul3
    832            case(61) ; clay_cas=resul3
    833            case(62) ; sand_cas=resul3
    834          end select
    835          resul=0.
    836          resul1=0.
    837          resul2=0.
    838          resul3=0.
    839        enddo
    840 !-----------------------------------------------------------------------
    841 
    842 
    843          return
    844          end subroutine read2_cas
     744        endif
     745     endif
     746     !-----------------------------------------------------------------------
     747     select case(i)
     748     case(1) ; ap=apbp       ! donnees indexees en nlevel+1
     749     case(2) ; bp=apbp
     750     case(3) ; zzh=apbp
     751     case(4) ; pph=apbp
     752     case(5) ; vitw=resul    ! donnees indexees en nlevel,time
     753     case(6) ; omega=resul
     754     case(7) ; ug=resul
     755     case(8) ; vg=resul
     756     case(9) ; du=resul
     757     case(10) ; hu=resul
     758     case(11) ; vu=resul
     759     case(12) ; dv=resul
     760     case(13) ; hv=resul
     761     case(14) ; vv=resul
     762     case(15) ; dt=resul
     763     case(16) ; ht=resul
     764     case(17) ; vt=resul
     765     case(18) ; dq=resul
     766     case(19) ; hq=resul
     767     case(20) ; vq=resul
     768     case(21) ; dth=resul
     769     case(22) ; hth=resul
     770     case(23) ; vth=resul
     771     case(24) ; hthl=resul
     772     case(25) ; dr=resul
     773     case(26) ; hr=resul
     774     case(27) ; vr=resul
     775     case(28) ; dtrad=resul
     776     case(29) ; q1=resul
     777     case(30) ; q2=resul
     778     case(31) ; uw=resul
     779     case(32) ; vw=resul
     780     case(33) ; rh=resul
     781     case(34) ; zz=resul      ! donnees en time,nlevel pour profil initial
     782     case(35) ; pp=resul
     783     case(36) ; temp=resul
     784     case(37) ; theta=resul
     785     case(38) ; thv=resul
     786     case(39) ; thl=resul
     787     case(40) ; qv=resul
     788     case(41) ; ql=resul
     789     case(42) ; qi=resul
     790     case(43) ; rv=resul
     791     case(44) ; u=resul
     792     case(45) ; v=resul
     793     case(46) ; sens=resul2   ! donnees indexees en time
     794     case(47) ; flat=resul2
     795     case(48) ; ts=resul2
     796     case(49) ; ps=resul2
     797     case(50) ; ustar=resul2
     798     case(51) ; tke=resul2
     799     case(52) ; orog_cas=resul3      ! constantes
     800     case(53) ; albedo_cas=resul3
     801     case(54) ; emiss_cas=resul3
     802     case(55) ; t_skin_cas=resul3
     803     case(56) ; q_skin_cas=resul3
     804     case(57) ; mom_rough=resul3
     805     case(58) ; heat_rough=resul3
     806     case(59) ; o3_cas=resul3       
     807     case(60) ; rugos_cas=resul3
     808     case(61) ; clay_cas=resul3
     809     case(62) ; sand_cas=resul3
     810     end select
     811     resul=0.
     812     resul1=0.
     813     resul2=0.
     814     resul3=0.
     815  enddo
     816  !-----------------------------------------------------------------------
     817
     818
     819  return
     820end subroutine read2_cas
    845821
    846822!======================================================================
    847       subroutine old_read_SCM(nid,nlevel,ntime,                                       &
    848      &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
    849      &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    850      &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
    851      &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    852      &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    853 
    854 !program reading forcing of the case study
    855       implicit none
     823subroutine old_read_SCM(nid,nlevel,ntime,                                       &
     824     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
     825     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
     826     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
     827     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
     828     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
     829
     830  !program reading forcing of the case study
     831  use netcdf, only: nf90_get_var
     832  implicit none
    856833#include "netcdf.inc"
    857834
    858       integer ntime,nlevel,k,t
    859 
    860       real ap(nlevel+1),bp(nlevel+1)
    861       real zz(nlevel,ntime),zzh(nlevel+1)
    862       real pp(nlevel,ntime),pph(nlevel+1)
    863 !profils initiaux
    864       real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
    865       real pp0(nlevel)   
    866       real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    867       real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    868       real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
    869       real ug(nlevel,ntime),vg(nlevel,ntime)
    870       real vitw(nlevel,ntime),omega(nlevel,ntime)
    871       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    872       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    873       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    874       real dtrad(nlevel,ntime)
    875       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    876       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    877       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    878       real flat(ntime),sens(ntime),ustar(ntime)
    879       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    880       real ts(ntime),ps(ntime)
    881       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
    882       real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    883 
    884 
    885       integer nid, ierr,ierr1,ierr2,rid,i
    886       integer nbvar3d
    887       parameter(nbvar3d=70)
    888       integer var3didin(nbvar3d),missing_var(nbvar3d)
    889       character*13 name_var(1:nbvar3d)
    890       data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    891      &'temp','qv','ql','qi','u','v','tke','pressure',&
    892      &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    893      &'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
    894      'rh',&
    895      &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
    896      &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
    897      &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
    898       do i=1,nbvar3d
    899         missing_var(i)=0.
    900       enddo
    901 
    902 !-----------------------------------------------------------------------
    903 
    904      print*,'ON EST LA'
    905        do i=1,nbvar3d
    906          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    907          if(ierr/=NF_NOERR) then
    908            print *,'Variable manquante dans cas.nc:',i,name_var(i)
    909            ierr=NF_NOERR
    910            missing_var(i)=1
    911          else
    912 !-----------------------------------------------------------------------
    913            if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    914 #ifdef NC_DOUBLE
    915            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)
    916 #else
    917            ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)
    918 #endif
     835  integer ntime,nlevel,k,t
     836
     837  real ap(nlevel+1),bp(nlevel+1)
     838  real zz(nlevel,ntime),zzh(nlevel+1)
     839  real pp(nlevel,ntime),pph(nlevel+1)
     840  !profils initiaux
     841  real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
     842  real pp0(nlevel)   
     843  real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
     844  real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
     845  real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
     846  real ug(nlevel,ntime),vg(nlevel,ntime)
     847  real vitw(nlevel,ntime),omega(nlevel,ntime)
     848  real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     849  real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     850  real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     851  real dtrad(nlevel,ntime)
     852  real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     853  real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
     854  real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     855  real flat(ntime),sens(ntime),ustar(ntime)
     856  real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     857  real ts(ntime),ps(ntime)
     858  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
     859  real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
     860
     861
     862  integer nid, ierr,ierr1,ierr2,rid,i
     863  integer nbvar3d
     864  parameter(nbvar3d=70)
     865  integer var3didin(nbvar3d),missing_var(nbvar3d)
     866  character*13 name_var(1:nbvar3d)
     867  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
     868       'temp','qv','ql','qi','u','v','tke','pressure',&
     869       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
     870       'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress', &
     871       'vstress','rh',&
     872       'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
     873       'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
     874       'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
     875  do i=1,nbvar3d
     876     missing_var(i)=0.
     877  enddo
     878
     879  !-----------------------------------------------------------------------
     880
     881  print*,'ON EST LA'
     882  do i=1,nbvar3d
     883     ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
     884     if(ierr/=NF_NOERR) then
     885        print *,'Variable manquante dans cas.nc:',i,name_var(i)
     886        ierr=NF_NOERR
     887        missing_var(i)=1
     888     else
     889        !-----------------------------------------------------------------------
     890        if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
     891           ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
    919892           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    920893           if(ierr/=NF_NOERR) then
    … …  
    922895              stop "getvarup"
    923896           endif
    924 !-----------------------------------------------------------------------
    925            else if(i.gt.4.and.i.LE.12) then   ! Lecture des variables en (time,nlevel,lat,lon)
    926 #ifdef NC_DOUBLE
    927            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)
    928 #else
    929            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)
    930 #endif
     897           !-----------------------------------------------------------------------
     898        else if(i.gt.4.and.i.LE.12) then   ! Lecture des variables en (time,nlevel,lat,lon)
     899           ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
    931900           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    932901           if(ierr/=NF_NOERR) then
    … …  
    934903              stop "getvarup"
    935904           endif
    936          print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    937 !-----------------------------------------------------------------------
    938            else if(i.gt.12.and.i.LE.54) then   ! Lecture des variables en (time,nlevel,lat,lon)
    939 #ifdef NC_DOUBLE
    940            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    941 #else
    942            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    943 #endif
     905           print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
     906           !-----------------------------------------------------------------------
     907        else if(i.gt.12.and.i.LE.54) then   ! Lecture des variables en (time,nlevel,lat,lon)
     908           ierr = NF90_GET_VAR(nid,var3didin(i),resul)
    944909           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    945910           if(ierr/=NF_NOERR) then
    … …  
    947912              stop "getvarup"
    948913           endif
    949          print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    950 !-----------------------------------------------------------------------
    951            else if (i.gt.54.and.i.LE.65) then   ! Lecture des variables en (time,lat,lon)
    952 #ifdef NC_DOUBLE
    953            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)
    954 #else
    955            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)
    956 #endif
     914           print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
     915           !-----------------------------------------------------------------------
     916        else if (i.gt.54.and.i.LE.65) then   ! Lecture des variables en (time,lat,lon)
     917           ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
    957918           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    958919           if(ierr/=NF_NOERR) then
    … …  
    960921              stop "getvarup"
    961922           endif
    962          print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
    963 !-----------------------------------------------------------------------
    964            else     ! Lecture des constantes (lat,lon)
    965 #ifdef NC_DOUBLE
    966            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)
    967 #else
    968            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)
    969 #endif
     923           print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
     924           !-----------------------------------------------------------------------
     925        else     ! Lecture des constantes (lat,lon)
     926           ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
    970927           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    971928           if(ierr/=NF_NOERR) then
    … …  
    973930              stop "getvarup"
    974931           endif
    975          print*,'Lecture de la variable #i ',i,name_var(i),resul3
    976            endif
    977          endif
    978 !-----------------------------------------------------------------------
    979          select case(i)
    980          !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    981          ! case(2) ; bp=apbp
    982            case(3) ; zzh=apbp
    983            case(4) ; pph=apbp
    984            case(5) ; temp0=resul1    ! donnees initiales
    985            case(6) ; qv0=resul1
    986            case(7) ; ql0=resul1
    987            case(8) ; qi0=resul1
    988            case(9) ; u0=resul1
    989            case(10) ; v0=resul1
    990            case(11) ; tke0=resul1
    991            case(12) ; pp0=resul1
    992            case(13) ; vitw=resul    ! donnees indexees en nlevel,time
    993            case(14) ; omega=resul
    994            case(15) ; ug=resul
    995            case(16) ; vg=resul
    996            case(17) ; du=resul
    997            case(18) ; hu=resul
    998            case(19) ; vu=resul
    999            case(20) ; dv=resul
    1000            case(21) ; hv=resul
    1001            case(22) ; vv=resul
    1002            case(23) ; dt=resul
    1003            case(24) ; ht=resul
    1004            case(25) ; vt=resul
    1005            case(26) ; dq=resul
    1006            case(27) ; hq=resul
    1007            case(28) ; vq=resul
    1008            case(29) ; dth=resul
    1009            case(30) ; hth=resul
    1010            case(31) ; vth=resul
    1011            case(32) ; hthl=resul
    1012            case(33) ; dr=resul
    1013            case(34) ; hr=resul
    1014            case(35) ; vr=resul
    1015            case(36) ; dtrad=resul
    1016            case(37) ; q1=resul
    1017            case(38) ; q2=resul
    1018            case(39) ; uw=resul
    1019            case(40) ; vw=resul
    1020            case(41) ; rh=resul
    1021            case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
    1022            case(43) ; pp=resul
    1023            case(44) ; temp=resul
    1024            case(45) ; theta=resul
    1025            case(46) ; thv=resul
    1026            case(47) ; thl=resul
    1027            case(48) ; qv=resul
    1028            case(49) ; ql=resul
    1029            case(50) ; qi=resul
    1030            case(51) ; rv=resul
    1031            case(52) ; u=resul
    1032            case(53) ; v=resul
    1033            case(54) ; tke=resul
    1034            case(55) ; sens=resul2   ! donnees indexees en time
    1035            case(56) ; flat=resul2
    1036            case(57) ; ts=resul2
    1037            case(58) ; ps=resul2
    1038            case(59) ; ustar=resul2
    1039            case(60) ; orog_cas=resul3      ! constantes
    1040            case(61) ; albedo_cas=resul3
    1041            case(62) ; emiss_cas=resul3
    1042            case(63) ; t_skin_cas=resul3
    1043            case(64) ; q_skin_cas=resul3
    1044            case(65) ; mom_rough=resul3
    1045            case(66) ; heat_rough=resul3
    1046            case(67) ; o3_cas=resul3       
    1047            case(68) ; rugos_cas=resul3
    1048            case(69) ; clay_cas=resul3
    1049            case(70) ; sand_cas=resul3
    1050          end select
    1051          resul=0.
    1052          resul1=0.
    1053          resul2=0.
    1054          resul3=0.
    1055        enddo
    1056          print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
    1057          print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
    1058 
    1059 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
    1060        do t=1,ntime
    1061           do k=1,nlevel
    1062              temp(k,t)=temp0(k)
    1063              qv(k,t)=qv0(k)
    1064              ql(k,t)=ql0(k)
    1065              qi(k,t)=qi0(k)
    1066              u(k,t)=u0(k)
    1067              v(k,t)=v0(k)
    1068              tke(k,t)=tke0(k)
    1069           enddo
    1070        enddo
    1071 !-----------------------------------------------------------------------
    1072 
    1073          return
    1074          end subroutine old_read_SCM
     932           print*,'Lecture de la variable #i ',i,name_var(i),resul3
     933        endif
     934     endif
     935     !-----------------------------------------------------------------------
     936     select case(i)
     937        !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
     938        ! case(2) ; bp=apbp
     939     case(3) ; zzh=apbp
     940     case(4) ; pph=apbp
     941     case(5) ; temp0=resul1    ! donnees initiales
     942     case(6) ; qv0=resul1
     943     case(7) ; ql0=resul1
     944     case(8) ; qi0=resul1
     945     case(9) ; u0=resul1
     946     case(10) ; v0=resul1
     947     case(11) ; tke0=resul1
     948     case(12) ; pp0=resul1
     949     case(13) ; vitw=resul    ! donnees indexees en nlevel,time
     950     case(14) ; omega=resul
     951     case(15) ; ug=resul
     952     case(16) ; vg=resul
     953     case(17) ; du=resul
     954     case(18) ; hu=resul
     955     case(19) ; vu=resul
     956     case(20) ; dv=resul
     957     case(21) ; hv=resul
     958     case(22) ; vv=resul
     959     case(23) ; dt=resul
     960     case(24) ; ht=resul
     961     case(25) ; vt=resul
     962     case(26) ; dq=resul
     963     case(27) ; hq=resul
     964     case(28) ; vq=resul
     965     case(29) ; dth=resul
     966     case(30) ; hth=resul
     967     case(31) ; vth=resul
     968     case(32) ; hthl=resul
     969     case(33) ; dr=resul
     970     case(34) ; hr=resul
     971     case(35) ; vr=resul
     972     case(36) ; dtrad=resul
     973     case(37) ; q1=resul
     974     case(38) ; q2=resul
     975     case(39) ; uw=resul
     976     case(40) ; vw=resul
     977     case(41) ; rh=resul
     978     case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
     979     case(43) ; pp=resul
     980     case(44) ; temp=resul
     981     case(45) ; theta=resul
     982     case(46) ; thv=resul
     983     case(47) ; thl=resul
     984     case(48) ; qv=resul
     985     case(49) ; ql=resul
     986     case(50) ; qi=resul
     987     case(51) ; rv=resul
     988     case(52) ; u=resul
     989     case(53) ; v=resul
     990     case(54) ; tke=resul
     991     case(55) ; sens=resul2   ! donnees indexees en time
     992     case(56) ; flat=resul2
     993     case(57) ; ts=resul2
     994     case(58) ; ps=resul2
     995     case(59) ; ustar=resul2
     996     case(60) ; orog_cas=resul3      ! constantes
     997     case(61) ; albedo_cas=resul3
     998     case(62) ; emiss_cas=resul3
     999     case(63) ; t_skin_cas=resul3
     1000     case(64) ; q_skin_cas=resul3
     1001     case(65) ; mom_rough=resul3
     1002     case(66) ; heat_rough=resul3
     1003     case(67) ; o3_cas=resul3       
     1004     case(68) ; rugos_cas=resul3
     1005     case(69) ; clay_cas=resul3
     1006     case(70) ; sand_cas=resul3
     1007     end select
     1008     resul=0.
     1009     resul1=0.
     1010     resul2=0.
     1011     resul3=0.
     1012  enddo
     1013  print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
     1014  print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
     1015
     1016  !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
     1017  do t=1,ntime
     1018     do k=1,nlevel
     1019        temp(k,t)=temp0(k)
     1020        qv(k,t)=qv0(k)
     1021        ql(k,t)=ql0(k)
     1022        qi(k,t)=qi0(k)
     1023        u(k,t)=u0(k)
     1024        v(k,t)=v0(k)
     1025        tke(k,t)=tke0(k)
     1026     enddo
     1027  enddo
     1028  !-----------------------------------------------------------------------
     1029
     1030  return
     1031end subroutine old_read_SCM
    10751032!======================================================================
    10761033
    10771034!======================================================================
    1078         SUBROUTINE interp_case_time2(day,day1,annee_ref                &
    1079 !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
    1080      &         ,nt_cas,nlev_cas                                       &
    1081      &         ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
    1082      &         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
    1083      &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
    1084      &         ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
    1085      &         ,uw_cas,vw_cas,q1_cas,q2_cas                           &
    1086      &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
    1087      &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
    1088      &         ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
    1089      &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
    1090      &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
    1091      &         ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
    1092      &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
    1093          
    1094 
    1095         implicit none
    1096 
    1097 !---------------------------------------------------------------------------------------
    1098 ! Time interpolation of a 2D field to the timestep corresponding to day
    1099 !
    1100 ! day: current julian day (e.g. 717538.2)
    1101 ! day1: first day of the simulation
    1102 ! nt_cas: total nb of data in the forcing
    1103 ! pdt_cas: total time interval (in sec) between 2 forcing data
    1104 !---------------------------------------------------------------------------------------
     1035SUBROUTINE interp_case_time2(day,day1,annee_ref                &
     1036     !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
     1037     ,nt_cas,nlev_cas                                       &
     1038     ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
     1039     ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
     1040     ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
     1041     ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
     1042     ,uw_cas,vw_cas,q1_cas,q2_cas                           &
     1043     ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
     1044     ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
     1045     ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
     1046     ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
     1047     ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
     1048     ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
     1049     ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
     1050
     1051
     1052  implicit none
     1053
     1054  !---------------------------------------------------------------------------------------
     1055  ! Time interpolation of a 2D field to the timestep corresponding to day
     1056  !
     1057  ! day: current julian day (e.g. 717538.2)
     1058  ! day1: first day of the simulation
     1059  ! nt_cas: total nb of data in the forcing
     1060  ! pdt_cas: total time interval (in sec) between 2 forcing data
     1061  !---------------------------------------------------------------------------------------
    11051062
    11061063#include "compar1d.h"
    11071064#include "date_cas.h"
    11081065
    1109 ! inputs:
    1110         integer annee_ref
    1111         integer nt_cas,nlev_cas
    1112         real day, day1,day_cas
    1113         real ts_cas(nt_cas),ps_cas(nt_cas)
    1114         real plev_cas(nlev_cas,nt_cas)
    1115         real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
    1116         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1117         real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1118         real vitw_cas(nlev_cas,nt_cas)
    1119         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1120         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1121         real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1122         real dtrad_cas(nlev_cas,nt_cas)
    1123         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1124         real lat_cas(nt_cas)
    1125         real sens_cas(nt_cas)
    1126         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1127         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    1128 
    1129 ! outputs:
    1130         real plev_prof_cas(nlev_cas)
    1131         real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    1132         real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1133         real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1134         real vitw_prof_cas(nlev_cas)
    1135         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1136         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1137         real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1138         real dtrad_prof_cas(nlev_cas)
    1139         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1140         real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    1141         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    1142 ! local:
    1143         integer it_cas1, it_cas2,k
    1144         real timeit,time_cas1,time_cas2,frac
    1145 
    1146 
    1147         print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    1148 
    1149 ! On teste si la date du cas AMMA est correcte.
    1150 ! C est pour memoire car en fait les fichiers .def
    1151 ! sont censes etre corrects.
    1152 ! A supprimer a terme (MPL 20150623)
    1153 !     if ((forcing_type.eq.10).and.(1.eq.0)) then
    1154 ! Check that initial day of the simulation consistent with AMMA case:
    1155 !      if (annee_ref.ne.2006) then
    1156 !       print*,'Pour AMMA, annee_ref doit etre 2006'
    1157 !       print*,'Changer annee_ref dans run.def'
    1158 !       stop
    1159 !      endif
    1160 !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
    1161 !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    1162 !       print*,'Changer dayref dans run.def'
    1163 !       stop
    1164 !      endif
    1165 !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
    1166 !       print*,'AMMA a fini le 11 juillet'
    1167 !       print*,'Changer dayref ou nday dans run.def'
    1168 !       stop
    1169 !      endif
    1170 !      endif
    1171 
    1172 ! Determine timestep relative to the 1st day:
    1173 !       timeit=(day-day1)*86400.
    1174 !       if (annee_ref.eq.1992) then
    1175 !        timeit=(day-day_cas)*86400.
    1176 !       else
    1177 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    1178 !       endif
    1179       timeit=(day-day_ju_ini_cas)*86400
    1180       print *,'day=',day
    1181       print *,'day_ju_ini_cas=',day_ju_ini_cas
    1182       print *,'pdt_cas=',pdt_cas
    1183       print *,'timeit=',timeit
    1184       print *,'nt_cas=',nt_cas
    1185 
    1186 ! Determine the closest observation times:
    1187 !       it_cas1=INT(timeit/pdt_cas)+1
    1188 !       it_cas2=it_cas1 + 1
    1189 !       time_cas1=(it_cas1-1)*pdt_cas
    1190 !       time_cas2=(it_cas2-1)*pdt_cas
    1191 
    1192        it_cas1=INT(timeit/pdt_cas)+1
    1193        IF (it_cas1 .EQ. nt_cas) THEN
    1194        it_cas2=it_cas1
    1195        ELSE
    1196        it_cas2=it_cas1 + 1
    1197        ENDIF
    1198        time_cas1=(it_cas1-1)*pdt_cas
    1199        time_cas2=(it_cas2-1)*pdt_cas
    1200        print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    1201 
    1202        if (it_cas1 .gt. nt_cas) then
    1203         write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    1204      &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    1205         stop
    1206        endif
    1207 
    1208 ! time interpolation:
    1209        IF (it_cas1 .EQ. it_cas2) THEN
    1210           frac=0.
    1211        ELSE
    1212           frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    1213           frac=max(frac,0.0)
    1214        ENDIF
    1215 
    1216        lat_prof_cas = lat_cas(it_cas2)                                       &
    1217      &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    1218        sens_prof_cas = sens_cas(it_cas2)                                     &
    1219      &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    1220        ts_prof_cas = ts_cas(it_cas2)                                         &
    1221      &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    1222        ustar_prof_cas = ustar_cas(it_cas2)                                   &
    1223      &          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    1224 
    1225        do k=1,nlev_cas
    1226         plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
    1227      &          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    1228         t_prof_cas(k) = t_cas(k,it_cas2)                               &
    1229      &          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    1230         q_prof_cas(k) = q_cas(k,it_cas2)                               &
    1231      &          -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
    1232         u_prof_cas(k) = u_cas(k,it_cas2)                               &
    1233      &          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    1234         v_prof_cas(k) = v_cas(k,it_cas2)                               &
    1235      &          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    1236         ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    1237      &          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    1238         vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    1239      &          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    1240         vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
    1241      &          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    1242         du_prof_cas(k) = du_cas(k,it_cas2)                                   &
    1243      &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    1244         hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
    1245      &          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    1246         vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
    1247      &          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    1248         dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
    1249      &          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    1250         hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
    1251      &          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    1252         vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
    1253      &          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    1254         dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
    1255      &          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    1256         ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
    1257      &          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    1258         vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
    1259      &          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    1260         dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
    1261      &          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    1262         dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
    1263      &          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    1264         hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
    1265      &          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    1266         vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
    1267      &          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    1268        uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
    1269      &          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    1270        vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
    1271      &          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1272        q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
    1273      &          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1274        q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
    1275      &          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1276         enddo
    1277 
    1278         return
    1279         END SUBROUTINE interp_case_time2
     1066  ! inputs:
     1067  integer annee_ref
     1068  integer nt_cas,nlev_cas
     1069  real day, day1,day_cas
     1070  real ts_cas(nt_cas),ps_cas(nt_cas)
     1071  real plev_cas(nlev_cas,nt_cas)
     1072  real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
     1073  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     1074  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     1075  real vitw_cas(nlev_cas,nt_cas)
     1076  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     1077  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     1078  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     1079  real dtrad_cas(nlev_cas,nt_cas)
     1080  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     1081  real lat_cas(nt_cas)
     1082  real sens_cas(nt_cas)
     1083  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     1084  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     1085
     1086  ! outputs:
     1087  real plev_prof_cas(nlev_cas)
     1088  real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
     1089  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     1090  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     1091  real vitw_prof_cas(nlev_cas)
     1092  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     1093  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     1094  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     1095  real dtrad_prof_cas(nlev_cas)
     1096  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     1097  real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
     1098  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     1099  ! local:
     1100  integer it_cas1, it_cas2,k
     1101  real timeit,time_cas1,time_cas2,frac
     1102
     1103
     1104  print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
     1105
     1106  ! On teste si la date du cas AMMA est correcte.
     1107  ! C est pour memoire car en fait les fichiers .def
     1108  ! sont censes etre corrects.
     1109  ! A supprimer a terme (MPL 20150623)
     1110  !     if ((forcing_type.eq.10).and.(1.eq.0)) then
     1111  ! Check that initial day of the simulation consistent with AMMA case:
     1112  !      if (annee_ref.ne.2006) then
     1113  !       print*,'Pour AMMA, annee_ref doit etre 2006'
     1114  !       print*,'Changer annee_ref dans run.def'
     1115  !       stop
     1116  !      endif
     1117  !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
     1118  !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     1119  !       print*,'Changer dayref dans run.def'
     1120  !       stop
     1121  !      endif
     1122  !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
     1123  !       print*,'AMMA a fini le 11 juillet'
     1124  !       print*,'Changer dayref ou nday dans run.def'
     1125  !       stop
     1126  !      endif
     1127  !      endif
     1128
     1129  ! Determine timestep relative to the 1st day:
     1130  !       timeit=(day-day1)*86400.
     1131  !       if (annee_ref.eq.1992) then
     1132  !        timeit=(day-day_cas)*86400.
     1133  !       else
     1134  !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     1135  !       endif
     1136  timeit=(day-day_ju_ini_cas)*86400
     1137  print *,'day=',day
     1138  print *,'day_ju_ini_cas=',day_ju_ini_cas
     1139  print *,'pdt_cas=',pdt_cas
     1140  print *,'timeit=',timeit
     1141  print *,'nt_cas=',nt_cas
     1142
     1143  ! Determine the closest observation times:
     1144  !       it_cas1=INT(timeit/pdt_cas)+1
     1145  !       it_cas2=it_cas1 + 1
     1146  !       time_cas1=(it_cas1-1)*pdt_cas
     1147  !       time_cas2=(it_cas2-1)*pdt_cas
     1148
     1149  it_cas1=INT(timeit/pdt_cas)+1
     1150  IF (it_cas1 .EQ. nt_cas) THEN
     1151     it_cas2=it_cas1
     1152  ELSE
     1153     it_cas2=it_cas1 + 1
     1154  ENDIF
     1155  time_cas1=(it_cas1-1)*pdt_cas
     1156  time_cas2=(it_cas2-1)*pdt_cas
     1157  print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
     1158
     1159  if (it_cas1 .gt. nt_cas) then
     1160     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     1161          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
     1162     stop
     1163  endif
     1164
     1165  ! time interpolation:
     1166  IF (it_cas1 .EQ. it_cas2) THEN
     1167     frac=0.
     1168  ELSE
     1169     frac=(time_cas2-timeit)/(time_cas2-time_cas1)
     1170     frac=max(frac,0.0)
     1171  ENDIF
     1172
     1173  lat_prof_cas = lat_cas(it_cas2)                                       &
     1174       -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
     1175  sens_prof_cas = sens_cas(it_cas2)                                     &
     1176       -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
     1177  ts_prof_cas = ts_cas(it_cas2)                                         &
     1178       -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
     1179  ustar_prof_cas = ustar_cas(it_cas2)                                   &
     1180       -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
     1181
     1182  do k=1,nlev_cas
     1183     plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
     1184          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
     1185     t_prof_cas(k) = t_cas(k,it_cas2)                               &
     1186          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
     1187     q_prof_cas(k) = q_cas(k,it_cas2)                               &
     1188          -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
     1189     u_prof_cas(k) = u_cas(k,it_cas2)                               &
     1190          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
     1191     v_prof_cas(k) = v_cas(k,it_cas2)                               &
     1192          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
     1193     ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
     1194          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
     1195     vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
     1196          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
     1197     vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
     1198          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
     1199     du_prof_cas(k) = du_cas(k,it_cas2)                                   &
     1200          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
     1201     hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
     1202          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
     1203     vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
     1204          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
     1205     dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
     1206          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
     1207     hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
     1208          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
     1209     vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
     1210          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
     1211     dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
     1212          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
     1213     ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
     1214          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
     1215     vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
     1216          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
     1217     dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
     1218          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
     1219     dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
     1220          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
     1221     hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
     1222          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
     1223     vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
     1224          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
     1225     uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
     1226          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
     1227     vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
     1228          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
     1229     q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
     1230          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
     1231     q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
     1232          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
     1233  enddo
     1234
     1235  return
     1236END SUBROUTINE interp_case_time2
    12801237
    12811238!**********************************************************************************************
    1282         SUBROUTINE interp2_case_time(day,day1,annee_ref                           &
    1283 !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
    1284      &         ,nt_cas,nlev_cas                                                   &
    1285      &         ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
    1286      &         ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
    1287      &         ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
    1288      &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
    1289      &         ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
    1290      &         ,lat_cas,sens_cas,ustar_cas                                        &
    1291      &         ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
    1292 !
    1293      &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    1294      &         ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    1295      &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
    1296      &         ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
    1297      &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
    1298      &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
    1299      &         ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
    1300      &         ,lat_prof_cas,sens_prof_cas                                        &
    1301      &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
    1302          
    1303 
    1304         implicit none
    1305 
    1306 !---------------------------------------------------------------------------------------
    1307 ! Time interpolation of a 2D field to the timestep corresponding to day
    1308 !
    1309 ! day: current julian day (e.g. 717538.2)
    1310 ! day1: first day of the simulation
    1311 ! nt_cas: total nb of data in the forcing
    1312 ! pdt_cas: total time interval (in sec) between 2 forcing data
    1313 !---------------------------------------------------------------------------------------
     1239SUBROUTINE interp2_case_time(day,day1,annee_ref                           &
     1240     !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
     1241     ,nt_cas,nlev_cas                                                   &
     1242     ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
     1243     ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
     1244     ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
     1245     ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
     1246     ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
     1247     ,lat_cas,sens_cas,ustar_cas                                        &
     1248     ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
     1249     !
     1250     ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
     1251     ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
     1252     ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
     1253     ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
     1254     ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
     1255     ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
     1256     ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
     1257     ,lat_prof_cas,sens_prof_cas                                        &
     1258     ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
     1259
     1260
     1261  implicit none
     1262
     1263  !---------------------------------------------------------------------------------------
     1264  ! Time interpolation of a 2D field to the timestep corresponding to day
     1265  !
     1266  ! day: current julian day (e.g. 717538.2)
     1267  ! day1: first day of the simulation
     1268  ! nt_cas: total nb of data in the forcing
     1269  ! pdt_cas: total time interval (in sec) between 2 forcing data
     1270  !---------------------------------------------------------------------------------------
    13141271
    13151272#include "compar1d.h"
    13161273#include "date_cas.h"
    13171274
    1318 ! inputs:
    1319         integer annee_ref
    1320         integer nt_cas,nlev_cas
    1321         real day, day1,day_cas
    1322         real ts_cas(nt_cas),ps_cas(nt_cas)
    1323         real plev_cas(nlev_cas,nt_cas)
    1324         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)
    1325         real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
    1326         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1327         real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1328         real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
    1329         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1330         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1331         real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1332         real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
    1333         real dtrad_cas(nlev_cas,nt_cas)
    1334         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1335         real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
    1336         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1337         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    1338 
    1339 ! outputs:
    1340         real plev_prof_cas(nlev_cas)
    1341         real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
    1342         real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    1343         real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1344         real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1345         real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
    1346         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1347         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1348         real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1349         real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    1350         real dtrad_prof_cas(nlev_cas)
    1351         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1352         real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
    1353         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    1354 ! local:
    1355         integer it_cas1, it_cas2,k
    1356         real timeit,time_cas1,time_cas2,frac
    1357 
    1358 
    1359         print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    1360 !       do k=1,nlev_cas
    1361 !       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
    1362 !       enddo
    1363 
    1364 ! On teste si la date du cas AMMA est correcte.
    1365 ! C est pour memoire car en fait les fichiers .def
    1366 ! sont censes etre corrects.
    1367 ! A supprimer a terme (MPL 20150623)
    1368 !     if ((forcing_type.eq.10).and.(1.eq.0)) then
    1369 ! Check that initial day of the simulation consistent with AMMA case:
    1370 !      if (annee_ref.ne.2006) then
    1371 !       print*,'Pour AMMA, annee_ref doit etre 2006'
    1372 !       print*,'Changer annee_ref dans run.def'
    1373 !       stop
    1374 !      endif
    1375 !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
    1376 !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    1377 !       print*,'Changer dayref dans run.def'
    1378 !       stop
    1379 !      endif
    1380 !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
    1381 !       print*,'AMMA a fini le 11 juillet'
    1382 !       print*,'Changer dayref ou nday dans run.def'
    1383 !       stop
    1384 !      endif
    1385 !      endif
    1386 
    1387 ! Determine timestep relative to the 1st day:
    1388 !       timeit=(day-day1)*86400.
    1389 !       if (annee_ref.eq.1992) then
    1390 !        timeit=(day-day_cas)*86400.
    1391 !       else
    1392 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    1393 !       endif
    1394       timeit=(day-day_ju_ini_cas)*86400
    1395       print *,'day=',day
    1396       print *,'day_ju_ini_cas=',day_ju_ini_cas
    1397       print *,'pdt_cas=',pdt_cas
    1398       print *,'timeit=',timeit
    1399       print *,'nt_cas=',nt_cas
    1400 
    1401 ! Determine the closest observation times:
    1402 !       it_cas1=INT(timeit/pdt_cas)+1
    1403 !       it_cas2=it_cas1 + 1
    1404 !       time_cas1=(it_cas1-1)*pdt_cas
    1405 !       time_cas2=(it_cas2-1)*pdt_cas
    1406 
    1407        it_cas1=INT(timeit/pdt_cas)+1
    1408        IF (it_cas1 .EQ. nt_cas) THEN
    1409        it_cas2=it_cas1
    1410        ELSE
    1411        it_cas2=it_cas1 + 1
    1412        ENDIF
    1413        time_cas1=(it_cas1-1)*pdt_cas
    1414        time_cas2=(it_cas2-1)*pdt_cas
    1415       print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
    1416       print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    1417 
    1418        if (it_cas1 .gt. nt_cas) then
    1419         write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    1420      &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    1421         stop
    1422        endif
    1423 
    1424 ! time interpolation:
    1425        IF (it_cas1 .EQ. it_cas2) THEN
    1426           frac=0.
    1427        ELSE
    1428           frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    1429           frac=max(frac,0.0)
    1430        ENDIF
    1431 
    1432        lat_prof_cas = lat_cas(it_cas2)                                   &
    1433      &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    1434        sens_prof_cas = sens_cas(it_cas2)                                 &
    1435      &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    1436        tke_prof_cas = tke_cas(it_cas2)                                   &
    1437      &          -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
    1438        ts_prof_cas = ts_cas(it_cas2)                                     &
    1439      &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    1440        ustar_prof_cas = ustar_cas(it_cas2)                               &
    1441      &          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    1442 
    1443        do k=1,nlev_cas
    1444         plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
    1445      &          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    1446         t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
    1447      &          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    1448         print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
    1449         theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
    1450      &          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
    1451         thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
    1452      &          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
    1453         thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
    1454      &          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
    1455         qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
    1456      &          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
    1457         ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
    1458      &          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
    1459         qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
    1460      &          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
    1461         u_prof_cas(k) = u_cas(k,it_cas2)                                 &
    1462      &          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    1463         v_prof_cas(k) = v_cas(k,it_cas2)                                 &
    1464      &          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    1465         ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    1466      &          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    1467         vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    1468      &          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    1469         vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
    1470      &          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    1471         omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
    1472      &          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
    1473         du_prof_cas(k) = du_cas(k,it_cas2)                               &
    1474      &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    1475         hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
    1476      &          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    1477         vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
    1478      &          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    1479         dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
    1480      &          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    1481         hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
    1482      &          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    1483         vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
    1484      &          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    1485         dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
    1486      &          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    1487         ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
    1488      &          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    1489         vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
    1490      &          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    1491         dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
    1492      &          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
    1493         hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
    1494      &          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
    1495         vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
    1496      &          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
    1497         dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
    1498      &          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    1499         dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
    1500      &          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    1501         hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
    1502      &          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    1503         vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
    1504      &          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    1505        uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
    1506      &          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    1507        vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
    1508      &          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1509        q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
    1510      &          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1511        q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
    1512      &          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1513         enddo
    1514 
    1515         return
    1516         END SUBROUTINE interp2_case_time
     1275  ! inputs:
     1276  integer annee_ref
     1277  integer nt_cas,nlev_cas
     1278  real day, day1,day_cas
     1279  real ts_cas(nt_cas),ps_cas(nt_cas)
     1280  real plev_cas(nlev_cas,nt_cas)
     1281  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)
     1282  real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
     1283  real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     1284  real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     1285  real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
     1286  real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     1287  real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     1288  real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     1289  real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
     1290  real dtrad_cas(nlev_cas,nt_cas)
     1291  real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     1292  real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
     1293  real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     1294  real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     1295
     1296  ! outputs:
     1297  real plev_prof_cas(nlev_cas)
     1298  real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
     1299  real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     1300  real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     1301  real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     1302  real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
     1303  real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     1304  real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     1305  real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     1306  real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     1307  real dtrad_prof_cas(nlev_cas)
     1308  real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     1309  real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
     1310  real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     1311  ! local:
     1312  integer it_cas1, it_cas2,k
     1313  real timeit,time_cas1,time_cas2,frac
     1314
     1315
     1316  print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
     1317  !       do k=1,nlev_cas
     1318  !       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
     1319  !       enddo
     1320
     1321  ! On teste si la date du cas AMMA est correcte.
     1322  ! C est pour memoire car en fait les fichiers .def
     1323  ! sont censes etre corrects.
     1324  ! A supprimer a terme (MPL 20150623)
     1325  !     if ((forcing_type.eq.10).and.(1.eq.0)) then
     1326  ! Check that initial day of the simulation consistent with AMMA case:
     1327  !      if (annee_ref.ne.2006) then
     1328  !       print*,'Pour AMMA, annee_ref doit etre 2006'
     1329  !       print*,'Changer annee_ref dans run.def'
     1330  !       stop
     1331  !      endif
     1332  !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
     1333  !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     1334  !       print*,'Changer dayref dans run.def'
     1335  !       stop
     1336  !      endif
     1337  !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
     1338  !       print*,'AMMA a fini le 11 juillet'
     1339  !       print*,'Changer dayref ou nday dans run.def'
     1340  !       stop
     1341  !      endif
     1342  !      endif
     1343
     1344  ! Determine timestep relative to the 1st day:
     1345  !       timeit=(day-day1)*86400.
     1346  !       if (annee_ref.eq.1992) then
     1347  !        timeit=(day-day_cas)*86400.
     1348  !       else
     1349  !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     1350  !       endif
     1351  timeit=(day-day_ju_ini_cas)*86400
     1352  print *,'day=',day
     1353  print *,'day_ju_ini_cas=',day_ju_ini_cas
     1354  print *,'pdt_cas=',pdt_cas
     1355  print *,'timeit=',timeit
     1356  print *,'nt_cas=',nt_cas
     1357
     1358  ! Determine the closest observation times:
     1359  !       it_cas1=INT(timeit/pdt_cas)+1
     1360  !       it_cas2=it_cas1 + 1
     1361  !       time_cas1=(it_cas1-1)*pdt_cas
     1362  !       time_cas2=(it_cas2-1)*pdt_cas
     1363
     1364  it_cas1=INT(timeit/pdt_cas)+1
     1365  IF (it_cas1 .EQ. nt_cas) THEN
     1366     it_cas2=it_cas1
     1367  ELSE
     1368     it_cas2=it_cas1 + 1
     1369  ENDIF
     1370  time_cas1=(it_cas1-1)*pdt_cas
     1371  time_cas2=(it_cas2-1)*pdt_cas
     1372  print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
     1373  print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
     1374
     1375  if (it_cas1 .gt. nt_cas) then
     1376     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     1377          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
     1378     stop
     1379  endif
     1380
     1381  ! time interpolation:
     1382  IF (it_cas1 .EQ. it_cas2) THEN
     1383     frac=0.
     1384  ELSE
     1385     frac=(time_cas2-timeit)/(time_cas2-time_cas1)
     1386     frac=max(frac,0.0)
     1387  ENDIF
     1388
     1389  lat_prof_cas = lat_cas(it_cas2)                                   &
     1390       -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
     1391  sens_prof_cas = sens_cas(it_cas2)                                 &
     1392       -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
     1393  tke_prof_cas = tke_cas(it_cas2)                                   &
     1394       -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
     1395  ts_prof_cas = ts_cas(it_cas2)                                     &
     1396       -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
     1397  ustar_prof_cas = ustar_cas(it_cas2)                               &
     1398       -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
     1399
     1400  do k=1,nlev_cas
     1401     plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
     1402          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
     1403     t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
     1404          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
     1405     print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
     1406     theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
     1407          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
     1408     thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
     1409          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
     1410     thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
     1411          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
     1412     qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
     1413          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
     1414     ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
     1415          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
     1416     qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
     1417          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
     1418     u_prof_cas(k) = u_cas(k,it_cas2)                                 &
     1419          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
     1420     v_prof_cas(k) = v_cas(k,it_cas2)                                 &
     1421          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
     1422     ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
     1423          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
     1424     vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
     1425          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
     1426     vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
     1427          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
     1428     omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
     1429          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
     1430     du_prof_cas(k) = du_cas(k,it_cas2)                               &
     1431          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
     1432     hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
     1433          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
     1434     vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
     1435          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
     1436     dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
     1437          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
     1438     hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
     1439          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
     1440     vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
     1441          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
     1442     dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
     1443          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
     1444     ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
     1445          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
     1446     vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
     1447          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
     1448     dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
     1449          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
     1450     hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
     1451          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
     1452     vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
     1453          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
     1454     dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
     1455          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
     1456     dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
     1457          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
     1458     hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
     1459          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
     1460     vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
     1461          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
     1462     uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
     1463          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
     1464     vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
     1465          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
     1466     q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
     1467          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
     1468     q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
     1469          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
     1470  enddo
     1471
     1472  return
     1473END SUBROUTINE interp2_case_time
    15171474
    15181475!**********************************************************************************************

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

    r4104 r4482  
    55
    66!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    7 !Declarations specifiques au cas standard
    8         character*80 :: fich_cas
    9 ! Discr?tisation
    10         integer nlev_cas, nt_cas
    11 
    12 
    13 !profils environnementaux
    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(:,:),tke_cas(:,:)
    21 
    22 !forcing
    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::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
    31         real, allocatable::  invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
    32         real, allocatable::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
    33         real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
    34 
    35 !champs interpoles
    36         real, allocatable::  plev_prof_cas(:)
    37         real, allocatable::  t_prof_cas(:)
    38         real, allocatable::  theta_prof_cas(:)
    39         real, allocatable::  thl_prof_cas(:)
    40         real, allocatable::  thv_prof_cas(:)
    41         real, allocatable::  q_prof_cas(:)
    42         real, allocatable::  qv_prof_cas(:)
    43         real, allocatable::  ql_prof_cas(:)
    44         real, allocatable::  qi_prof_cas(:)
    45         real, allocatable::  rh_prof_cas(:)
    46         real, allocatable::  rv_prof_cas(:)
    47         real, allocatable::  u_prof_cas(:)
    48         real, allocatable::  v_prof_cas(:)       
    49         real, allocatable::  vitw_prof_cas(:)
    50         real, allocatable::  omega_prof_cas(:)
    51         real, allocatable::  tke_prof_cas(:)
    52         real, allocatable::  ug_prof_cas(:)
    53         real, allocatable::  vg_prof_cas(:)
    54         real, allocatable::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
    55         real, allocatable::  invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
    56 
    57         real, allocatable::  ht_prof_cas(:)
    58         real, allocatable::  hth_prof_cas(:)
    59         real, allocatable::  hq_prof_cas(:)
    60         real, allocatable::  vt_prof_cas(:)
    61         real, allocatable::  vth_prof_cas(:)
    62         real, allocatable::  vq_prof_cas(:)
    63         real, allocatable::  dt_prof_cas(:)
    64         real, allocatable::  dth_prof_cas(:)
    65         real, allocatable::  dtrad_prof_cas(:)
    66         real, allocatable::  dq_prof_cas(:)
    67         real, allocatable::  hu_prof_cas(:)
    68         real, allocatable::  hv_prof_cas(:)
    69         real, allocatable::  vu_prof_cas(:)
    70         real, allocatable::  vv_prof_cas(:)
    71         real, allocatable::  du_prof_cas(:)
    72         real, allocatable::  dv_prof_cas(:)
    73         real, allocatable::  uw_prof_cas(:)
    74         real, allocatable::  vw_prof_cas(:)
    75         real, allocatable::  q1_prof_cas(:)
    76         real, allocatable::  q2_prof_cas(:)
    77 
    78 
    79         real o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
    80         real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
    81      
     7  !Declarations specifiques au cas standard
     8  character*80 :: fich_cas
     9  ! Discr?tisation
     10  integer nlev_cas, nt_cas
     11
     12
     13  !profils environnementaux
     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(:,:),tke_cas(:,:)
     21
     22  !forcing
     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::  temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:)
     31  real, allocatable::  invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:)
     32  real, allocatable::  lat_cas(:),sens_cas(:),tskin_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
     33  real, allocatable::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:)
     34
     35  !champs interpoles
     36  real, allocatable::  plev_prof_cas(:)
     37  real, allocatable::  t_prof_cas(:)
     38  real, allocatable::  theta_prof_cas(:)
     39  real, allocatable::  thl_prof_cas(:)
     40  real, allocatable::  thv_prof_cas(:)
     41  real, allocatable::  q_prof_cas(:)
     42  real, allocatable::  qv_prof_cas(:)
     43  real, allocatable::  ql_prof_cas(:)
     44  real, allocatable::  qi_prof_cas(:)
     45  real, allocatable::  rh_prof_cas(:)
     46  real, allocatable::  rv_prof_cas(:)
     47  real, allocatable::  u_prof_cas(:)
     48  real, allocatable::  v_prof_cas(:)       
     49  real, allocatable::  vitw_prof_cas(:)
     50  real, allocatable::  omega_prof_cas(:)
     51  real, allocatable::  tke_prof_cas(:)
     52  real, allocatable::  ug_prof_cas(:)
     53  real, allocatable::  vg_prof_cas(:)
     54  real, allocatable::  temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:)
     55  real, allocatable::  invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:)
     56
     57  real, allocatable::  ht_prof_cas(:)
     58  real, allocatable::  hth_prof_cas(:)
     59  real, allocatable::  hq_prof_cas(:)
     60  real, allocatable::  vt_prof_cas(:)
     61  real, allocatable::  vth_prof_cas(:)
     62  real, allocatable::  vq_prof_cas(:)
     63  real, allocatable::  dt_prof_cas(:)
     64  real, allocatable::  dth_prof_cas(:)
     65  real, allocatable::  dtrad_prof_cas(:)
     66  real, allocatable::  dq_prof_cas(:)
     67  real, allocatable::  hu_prof_cas(:)
     68  real, allocatable::  hv_prof_cas(:)
     69  real, allocatable::  vu_prof_cas(:)
     70  real, allocatable::  vv_prof_cas(:)
     71  real, allocatable::  du_prof_cas(:)
     72  real, allocatable::  dv_prof_cas(:)
     73  real, allocatable::  uw_prof_cas(:)
     74  real, allocatable::  vw_prof_cas(:)
     75  real, allocatable::  q1_prof_cas(:)
     76  real, allocatable::  q2_prof_cas(:)
     77
     78
     79  real o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas
     80  real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
     81
    8282
    8383
    … …  
    8585
    8686
    87 !**********************************************************************************************
    88 SUBROUTINE read_SCM_cas
    89       implicit none
     87  !**********************************************************************************************
     88  SUBROUTINE read_SCM_cas
     89    use netcdf, only: nf90_get_var
     90    implicit none
    9091
    9192#include "netcdf.inc"
    9293#include "date_cas.h"
    9394
    94       INTEGER nid,rid,ierr
    95       INTEGER ii,jj,timeid
    96       REAL, ALLOCATABLE :: time_val(:)
    97 
    98       fich_cas='cas.nc'
    99       print*,'fich_cas ',fich_cas
    100       ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    101       print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    102       if (ierr.NE.NF_NOERR) then
    103          write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    104          write(*,*) NF_STRERROR(ierr)
    105          stop ""
    106       endif
    107 !.......................................................................
    108       ierr=NF_INQ_DIMID(nid,'lat',rid)
    109       IF (ierr.NE.NF_NOERR) THEN
    110          print*, 'Oh probleme lecture dimension lat'
    111       ENDIF
    112       ierr=NF_INQ_DIMLEN(nid,rid,ii)
    113       print*,'OK1 read2: nid,rid,lat',nid,rid,ii
    114 !.......................................................................
    115       ierr=NF_INQ_DIMID(nid,'lon',rid)
    116       IF (ierr.NE.NF_NOERR) THEN
    117          print*, 'Oh probleme lecture dimension lon'
    118       ENDIF
    119       ierr=NF_INQ_DIMLEN(nid,rid,jj)
    120       print*,'OK2 read2: nid,rid,lat',nid,rid,jj
    121 !.......................................................................
    122       ierr=NF_INQ_DIMID(nid,'lev',rid)
    123       IF (ierr.NE.NF_NOERR) THEN
    124          print*, 'Oh probleme lecture dimension nlev'
    125       ENDIF
    126       ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
    127       print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
    128       IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 200000 )) THEN
    129               print*,'Valeur de nlev_cas peu probable'
    130               STOP
    131       ENDIF
    132 !.......................................................................
    133       ierr=NF_INQ_DIMID(nid,'time',rid)
    134       nt_cas=0
    135       IF (ierr.NE.NF_NOERR) THEN
    136         stop 'Oh probleme lecture dimension time'
    137       ENDIF
    138       ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
    139       print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
    140 ! Lecture de l'axe des temps
    141       print*,'LECTURE DU TEMPS'
    142       ierr=NF_INQ_VARID(nid,'time',timeid)
    143          if(ierr/=NF_NOERR) then
    144            print *,'Variable time manquante dans cas.nc:'
    145            ierr=NF_NOERR
    146          else
    147                  allocate(time_val(nt_cas))
    148 #ifdef NC_DOUBLE
    149          ierr = NF_GET_VAR_DOUBLE(nid,timeid,time_val)
    150 #else
    151            ierr = NF_GET_VAR_REAL(nid,timeid,time_val)
    152 #endif
    153            if(ierr/=NF_NOERR) then
    154               print *,'Pb a la lecture de time cas.nc: '
    155            endif
    156    endif
    157    IF (nt_cas>1) THEN
    158            pdt_cas=time_val(2)-time_val(1)
    159    ELSE
    160            pdt_cas=0.
    161    ENDIF
     95    INTEGER nid,rid,ierr
     96    INTEGER ii,jj,timeid
     97    REAL, ALLOCATABLE :: time_val(:)
     98
     99    fich_cas='cas.nc'
     100    print*,'fich_cas ',fich_cas
     101    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
     102    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
     103    if (ierr.NE.NF_NOERR) then
     104       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
     105       write(*,*) NF_STRERROR(ierr)
     106       stop ""
     107    endif
     108    !.......................................................................
     109    ierr=NF_INQ_DIMID(nid,'lat',rid)
     110    IF (ierr.NE.NF_NOERR) THEN
     111       print*, 'Oh probleme lecture dimension lat'
     112    ENDIF
     113    ierr=NF_INQ_DIMLEN(nid,rid,ii)
     114    print*,'OK1 read_SCM_cas: nid,rid,lat',nid,rid,ii
     115    !.......................................................................
     116    ierr=NF_INQ_DIMID(nid,'lon',rid)
     117    IF (ierr.NE.NF_NOERR) THEN
     118       print*, 'Oh probleme lecture dimension lon'
     119    ENDIF
     120    ierr=NF_INQ_DIMLEN(nid,rid,jj)
     121    print*,'OK2 read_SCM_cas: nid,rid,lat',nid,rid,jj
     122    !.......................................................................
     123    ierr=NF_INQ_DIMID(nid,'lev',rid)
     124    IF (ierr.NE.NF_NOERR) THEN
     125       print*, 'Oh probleme lecture dimension nlev'
     126    ENDIF
     127    ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas)
     128    print*,'OK3 read_SCM_cas: nid,rid,nlev_cas',nid,rid,nlev_cas
     129    IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 200000 )) THEN
     130       print*,'Valeur de nlev_cas peu probable'
     131       STOP
     132    ENDIF
     133    !.......................................................................
     134    ierr=NF_INQ_DIMID(nid,'time',rid)
     135    nt_cas=0
     136    IF (ierr.NE.NF_NOERR) THEN
     137       stop 'Oh probleme lecture dimension time'
     138    ENDIF
     139    ierr=NF_INQ_DIMLEN(nid,rid,nt_cas)
     140    print*,'OK4 read_SCM_cas: nid,rid,nt_cas',nid,rid,nt_cas
     141    ! Lecture de l'axe des temps
     142    print*,'LECTURE DU TEMPS'
     143    ierr=NF_INQ_VARID(nid,'time',timeid)
     144    if(ierr/=NF_NOERR) then
     145       print *,'Variable time manquante dans cas.nc:'
     146       ierr=NF_NOERR
     147    else
     148       allocate(time_val(nt_cas))
     149       ierr = NF90_GET_VAR(nid,timeid,time_val)
     150       if(ierr/=NF_NOERR) then
     151          print *,'A Pb a la lecture de time cas.nc: '
     152       endif
     153    endif
     154    IF (nt_cas>1) THEN
     155       pdt_cas=time_val(2)-time_val(1)
     156    ELSE
     157       pdt_cas=0.
     158    ENDIF
    162159
    163160
    164161!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    165 !profils moyens:
    166         allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    167         allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    168         allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
    169         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), &
    170              qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    171         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))
    172         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))
    173         allocate(tke_cas(nlev_cas,nt_cas))
    174 !forcing
    175         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))
    176         allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    177         allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    178         allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    179         allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    180         allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    181         allocate(ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas))
    182         allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas))
    183         allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas))
    184         allocate(invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas))
    185         allocate(invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas))
    186         allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas))
    187         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))
    188 
    189 
    190 
    191 !champs interpoles
    192         allocate(plev_prof_cas(nlev_cas))
    193         allocate(t_prof_cas(nlev_cas))
    194         allocate(theta_prof_cas(nlev_cas))
    195         allocate(thl_prof_cas(nlev_cas))
    196         allocate(thv_prof_cas(nlev_cas))
    197         allocate(q_prof_cas(nlev_cas))
    198         allocate(qv_prof_cas(nlev_cas))
    199         allocate(ql_prof_cas(nlev_cas))
    200         allocate(qi_prof_cas(nlev_cas))
    201         allocate(rh_prof_cas(nlev_cas))
    202         allocate(rv_prof_cas(nlev_cas))
    203         allocate(u_prof_cas(nlev_cas))
    204         allocate(v_prof_cas(nlev_cas))
    205         allocate(vitw_prof_cas(nlev_cas))
    206         allocate(omega_prof_cas(nlev_cas))
    207         allocate(tke_prof_cas(nlev_cas))
    208         allocate(ug_prof_cas(nlev_cas))
    209         allocate(vg_prof_cas(nlev_cas))
    210         allocate(temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas))
    211         allocate(u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas))
    212         allocate(invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas))
    213         allocate(invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas))
    214         allocate(ht_prof_cas(nlev_cas))
    215         allocate(hth_prof_cas(nlev_cas))
    216         allocate(hq_prof_cas(nlev_cas))
    217         allocate(hu_prof_cas(nlev_cas))
    218         allocate(hv_prof_cas(nlev_cas))
    219         allocate(vt_prof_cas(nlev_cas))
    220         allocate(vth_prof_cas(nlev_cas))
    221         allocate(vq_prof_cas(nlev_cas))
    222         allocate(vu_prof_cas(nlev_cas))
    223         allocate(vv_prof_cas(nlev_cas))
    224         allocate(dt_prof_cas(nlev_cas))
    225         allocate(dth_prof_cas(nlev_cas))
    226         allocate(dtrad_prof_cas(nlev_cas))
    227         allocate(dq_prof_cas(nlev_cas))
    228         allocate(du_prof_cas(nlev_cas))
    229         allocate(dv_prof_cas(nlev_cas))
    230         allocate(uw_prof_cas(nlev_cas))
    231         allocate(vw_prof_cas(nlev_cas))
    232         allocate(q1_prof_cas(nlev_cas))
    233         allocate(q2_prof_cas(nlev_cas))
    234 
    235         print*,'Allocations OK'
    236         CALL read_SCM (nid,nlev_cas,nt_cas,                                                                     &
    237      &     ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                   &
    238      &     ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas,                            &
    239      &     temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas,                                                     &
    240      &     invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas,                         &
    241      &     du_cas,hu_cas,vu_cas,                                                                                &
    242      &     dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
    243      &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,                      &
    244      &     uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
    245      &     o3_cas,rugos_cas,clay_cas,sand_cas)
    246         print*,'read_SCM cas OK'
    247         do ii=1,nlev_cas
    248         print*,'apres read2_SCM, plev_cas=',ii,plev_cas(ii,1)
    249         !print*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
    250         enddo
    251 
    252 
    253 END SUBROUTINE read_SCM_cas
     162    !profils moyens:
     163    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
     164    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
     165    allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
     166    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), &
     167         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
     168    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))
     169    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))
     170    allocate(tke_cas(nlev_cas,nt_cas))
     171    !forcing
     172    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))
     173    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
     174    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
     175    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
     176    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
     177    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
     178    allocate(ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas))
     179    allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas))
     180    allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas))
     181    allocate(invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas))
     182    allocate(invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas))
     183    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas))
     184    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))
     185
     186
     187
     188    !champs interpoles
     189    allocate(plev_prof_cas(nlev_cas))
     190    allocate(t_prof_cas(nlev_cas))
     191    allocate(theta_prof_cas(nlev_cas))
     192    allocate(thl_prof_cas(nlev_cas))
     193    allocate(thv_prof_cas(nlev_cas))
     194    allocate(q_prof_cas(nlev_cas))
     195    allocate(qv_prof_cas(nlev_cas))
     196    allocate(ql_prof_cas(nlev_cas))
     197    allocate(qi_prof_cas(nlev_cas))
     198    allocate(rh_prof_cas(nlev_cas))
     199    allocate(rv_prof_cas(nlev_cas))
     200    allocate(u_prof_cas(nlev_cas))
     201    allocate(v_prof_cas(nlev_cas))
     202    allocate(vitw_prof_cas(nlev_cas))
     203    allocate(omega_prof_cas(nlev_cas))
     204    allocate(tke_prof_cas(nlev_cas))
     205    allocate(ug_prof_cas(nlev_cas))
     206    allocate(vg_prof_cas(nlev_cas))
     207    allocate(temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas))
     208    allocate(u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas))
     209    allocate(invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas))
     210    allocate(invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas))
     211    allocate(ht_prof_cas(nlev_cas))
     212    allocate(hth_prof_cas(nlev_cas))
     213    allocate(hq_prof_cas(nlev_cas))
     214    allocate(hu_prof_cas(nlev_cas))
     215    allocate(hv_prof_cas(nlev_cas))
     216    allocate(vt_prof_cas(nlev_cas))
     217    allocate(vth_prof_cas(nlev_cas))
     218    allocate(vq_prof_cas(nlev_cas))
     219    allocate(vu_prof_cas(nlev_cas))
     220    allocate(vv_prof_cas(nlev_cas))
     221    allocate(dt_prof_cas(nlev_cas))
     222    allocate(dth_prof_cas(nlev_cas))
     223    allocate(dtrad_prof_cas(nlev_cas))
     224    allocate(dq_prof_cas(nlev_cas))
     225    allocate(du_prof_cas(nlev_cas))
     226    allocate(dv_prof_cas(nlev_cas))
     227    allocate(uw_prof_cas(nlev_cas))
     228    allocate(vw_prof_cas(nlev_cas))
     229    allocate(q1_prof_cas(nlev_cas))
     230    allocate(q2_prof_cas(nlev_cas))
     231
     232    print*,'Allocations OK'
     233    CALL read_SCM (nid,nlev_cas,nt_cas,                                                                     &
     234         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                   &
     235         ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas,                            &
     236         temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas,                                                     &
     237         invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas,                         &
     238         du_cas,hu_cas,vu_cas,                                                                                &
     239         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
     240         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,tskin_cas,ps_cas,ustar_cas,tkes_cas,            &
     241         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough, &
     242         o3_cas,rugos_cas,clay_cas,sand_cas)
     243    print*,'read_SCM cas OK'
     244    do ii=1,nlev_cas
     245       print*,'apres read_SCM_cas, plev_cas=',ii,plev_cas(ii,1)
     246       !print*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
     247    enddo
     248
     249
     250  END SUBROUTINE read_SCM_cas
    254251
    255252
    256253!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    257 SUBROUTINE deallocate2_1D_cases
    258 !profils environnementaux:
    259         deallocate(plev_cas,plevh_cas)
    260        
    261         deallocate(z_cas,zh_cas)
    262         deallocate(ap_cas,bp_cas)
    263         deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
    264         deallocate(th_cas,thl_cas,thv_cas,rv_cas)
    265         deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas)
    266        
    267 !forcing
    268         deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    269         deallocate(hq_cas,vq_cas,dq_cas)
    270         deallocate(hth_cas,vth_cas,dth_cas)
    271         deallocate(hr_cas,vr_cas,dr_cas)
    272         deallocate(hu_cas,vu_cas,du_cas)
    273         deallocate(hv_cas,vv_cas,dv_cas)
    274         deallocate(ug_cas)
    275         deallocate(vg_cas)
    276         deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    277 
    278 !champs interpoles
    279         deallocate(plev_prof_cas)
    280         deallocate(t_prof_cas)
    281         deallocate(theta_prof_cas)
    282         deallocate(thl_prof_cas)
    283         deallocate(thv_prof_cas)
    284         deallocate(q_prof_cas)
    285         deallocate(qv_prof_cas)
    286         deallocate(ql_prof_cas)
    287         deallocate(qi_prof_cas)
    288         deallocate(rh_prof_cas)
    289         deallocate(rv_prof_cas)
    290         deallocate(u_prof_cas)
    291         deallocate(v_prof_cas)
    292         deallocate(vitw_prof_cas)
    293         deallocate(omega_prof_cas)
    294         deallocate(tke_prof_cas)
    295         deallocate(ug_prof_cas)
    296         deallocate(vg_prof_cas)
    297         deallocate(temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas)
    298         deallocate(invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas)
    299         deallocate(ht_prof_cas)
    300         deallocate(hq_prof_cas)
    301         deallocate(hu_prof_cas)
    302         deallocate(hv_prof_cas)
    303         deallocate(vt_prof_cas)
    304         deallocate(vq_prof_cas)
    305         deallocate(vu_prof_cas)
    306         deallocate(vv_prof_cas)
    307         deallocate(dt_prof_cas)
    308         deallocate(dtrad_prof_cas)
    309         deallocate(dq_prof_cas)
    310         deallocate(du_prof_cas)
    311         deallocate(dv_prof_cas)
    312         deallocate(t_prof_cas)
    313         deallocate(u_prof_cas)
    314         deallocate(v_prof_cas)
    315         deallocate(uw_prof_cas)
    316         deallocate(vw_prof_cas)
    317         deallocate(q1_prof_cas)
    318         deallocate(q2_prof_cas)
    319 
    320 END SUBROUTINE deallocate2_1D_cases
    321 
    322 
    323 !=====================================================================
    324       SUBROUTINE read_SCM(nid,nlevel,ntime,                                       &
    325      &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,&
    326      &     temp_nudg,qv_nudg,u_nudg,v_nudg,                                        &
    327      &     invtau_temp_nudg,invtau_qv_nudg,invtau_u_nudg,invtau_v_nudg,             &
    328      &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    329      &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tkes,uw,vw,q1,q2,       &
    330      &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    331      &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    332 
    333 !program reading forcing of the case study
    334       implicit none
     254  SUBROUTINE deallocate2_1D_cases
     255    !profils environnementaux:
     256    deallocate(plev_cas,plevh_cas)
     257
     258    deallocate(z_cas,zh_cas)
     259    deallocate(ap_cas,bp_cas)
     260    deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
     261    deallocate(th_cas,thl_cas,thv_cas,rv_cas)
     262    deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas)
     263
     264    !forcing
     265    deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
     266    deallocate(hq_cas,vq_cas,dq_cas)
     267    deallocate(hth_cas,vth_cas,dth_cas)
     268    deallocate(hr_cas,vr_cas,dr_cas)
     269    deallocate(hu_cas,vu_cas,du_cas)
     270    deallocate(hv_cas,vv_cas,dv_cas)
     271    deallocate(ug_cas)
     272    deallocate(vg_cas)
     273    deallocate(lat_cas,sens_cas,tskin_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas)
     274
     275    !champs interpoles
     276    deallocate(plev_prof_cas)
     277    deallocate(t_prof_cas)
     278    deallocate(theta_prof_cas)
     279    deallocate(thl_prof_cas)
     280    deallocate(thv_prof_cas)
     281    deallocate(q_prof_cas)
     282    deallocate(qv_prof_cas)
     283    deallocate(ql_prof_cas)
     284    deallocate(qi_prof_cas)
     285    deallocate(rh_prof_cas)
     286    deallocate(rv_prof_cas)
     287    deallocate(u_prof_cas)
     288    deallocate(v_prof_cas)
     289    deallocate(vitw_prof_cas)
     290    deallocate(omega_prof_cas)
     291    deallocate(tke_prof_cas)
     292    deallocate(ug_prof_cas)
     293    deallocate(vg_prof_cas)
     294    deallocate(temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas)
     295    deallocate(invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas)
     296    deallocate(ht_prof_cas)
     297    deallocate(hq_prof_cas)
     298    deallocate(hu_prof_cas)
     299    deallocate(hv_prof_cas)
     300    deallocate(vt_prof_cas)
     301    deallocate(vq_prof_cas)
     302    deallocate(vu_prof_cas)
     303    deallocate(vv_prof_cas)
     304    deallocate(dt_prof_cas)
     305    deallocate(dtrad_prof_cas)
     306    deallocate(dq_prof_cas)
     307    deallocate(du_prof_cas)
     308    deallocate(dv_prof_cas)
     309    deallocate(t_prof_cas)
     310    deallocate(u_prof_cas)
     311    deallocate(v_prof_cas)
     312    deallocate(uw_prof_cas)
     313    deallocate(vw_prof_cas)
     314    deallocate(q1_prof_cas)
     315    deallocate(q2_prof_cas)
     316
     317  END SUBROUTINE deallocate2_1D_cases
     318
     319
     320  !=====================================================================
     321  SUBROUTINE read_SCM(nid,nlevel,ntime,                                       &
     322       ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,&
     323       temp_nudg,qv_nudg,u_nudg,v_nudg,                                        &
     324       invtau_temp_nudg,invtau_qv_nudg,invtau_u_nudg,invtau_v_nudg,             &
     325       du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
     326       dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,tskin,ps,ustar,tkes,uw,vw,q1,q2,       &
     327       orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,          &
     328       heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
     329
     330    !program reading forcing of the case study
     331    use netcdf, only: nf90_get_var
     332    implicit none
    335333#include "netcdf.inc"
    336334#include "compar1d.h"
    337335
    338       integer ntime,nlevel,k,t
    339 
    340       real ap(nlevel+1),bp(nlevel+1)
    341       real zz(nlevel,ntime),zzh(nlevel+1)
    342       real pp(nlevel,ntime),pph(nlevel+1)
    343 !profils initiaux
    344       real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
    345       real pp0(nlevel)   
    346       real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    347       real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    348       real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
    349       real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
    350       real invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
    351       real ug(nlevel,ntime),vg(nlevel,ntime)
    352       real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
    353       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    354       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    355       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    356       real dtrad(nlevel,ntime)
    357       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    358       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    359       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    360       real flat(ntime),sens(ntime),ustar(ntime)
    361       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    362       real ts(ntime),ps(ntime)
    363       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
    364       real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    365 
    366 
    367       integer nid, ierr,ierr1,ierr2,rid,i,int_test
    368       integer nbvar3d
    369       parameter(nbvar3d=78)
    370       integer var3didin(nbvar3d),missing_var(nbvar3d)
    371       character*13 name_var(1:nbvar3d)
    372 
    373 
    374 !      data name_var/ &
    375 !     ! coordonnees pression (n+1 niveaux) #4
    376 !     & 'coor_par_a','coor_par_b','height_h','pressure_h',& ! #1-#4
    377 !     ! coordonnees pression (n niveaux) #8
    378 !     &'temp','qv','ql','qi','u','v','tke','pressure',& ! #5-#12
    379 !     ! coordonnees pression + temps #42
    380 !     &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','temp_adv','tadvh','tadvv',& !  #13 - #25
    381 !     &'qv_adv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh',                             & ! #26 - #32
    382 !     & 'radv','radvh','radvv','radcool','q1','q2','ustress','vstress',                           & ! #33 - #40
    383 !     & 'rh','temp_nudging','qv_nudging','u_nudging','v_nudging',                                       & ! #41-45
    384 !     &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt',   & ! #46-58
    385 !     ! coordonnees temps #12
    386 !     &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
    387 !     &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',&
    388 !     ! scalaires #4
    389 !     &'o3','rugos','clay','sand'/
    390 
    391 
    392 
    393       data name_var/ &
    394      ! coordonnees pression (n+1 niveaux) #4
    395      & 'coor_par_a','coor_par_b','zf','pressure_h',& ! #1-#4
    396      ! coordonnees pression (n niveaux) #8
    397      & 'ta','qv','ql','qi','ua','va','tke','pa',& ! #5-#12
    398      ! coordonnees pression + temps #46
    399      & 'wa','wap','ug','vg','tnua_adv','tnua_advh','tnua_advv','tnva_adv','tnva_advh','tnva_advv','tnta_adv','tnta_advh','tnta_advv',& !  #13 - #25
    400      & 'tnqv_adv','tnqv_advh','tnqv_advv','thadv','thadvh','thadvv','thladvh',                             & ! #26 - #32
    401      & 'radv','radvh','radvv','tnta_rad','q1','q2','ustress','vstress',                           & ! #33 - #40
    402      & 'rh','ta_nud','qv_nud','ua_nud','va_nud',                                       & ! #41-45
    403      & 'zh_forc','pa_forc','tat','thetat','thetavt','thetalt','qvt','qlt','qit','rv','uat','vat',   & ! #46-57
    404      & 'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va',           & ! # 58-61
    405      ! coordonnees temps #12
    406      & 'tkes','hfss','hfls','ts_forc','ps_forc','ustar', &                                        ! 62-67
    407      & 'orog','albedo','emiss','t_skin','q_skin','z0','z0h',       &                    ! 68-74
    408      ! scalaires #4                               
    409      & 'O3','rugos','clay','sand'/                                                      ! 75-78
    410 
    411 
    412 !-----------------------------------------------------------------------
    413 ! First check that we are using a version > v2 of the 1D standard format
    414 ! use the difference between 'temp' (old version) and 'ta' (new version)
    415 !-----------------------------------------------------------------------
    416 
    417 
    418          ierr=NF_INQ_VARID(nid,'ta',int_test)
    419          if(ierr/=NF_NOERR) then
    420            print*, '++++++++++++++++++++++++++++++'
    421            print*, 'variable ta missing in cas.nc '
    422            print*, 'You are probably using an obsolete version of the 1D cases'
    423            print*, 'please dowload the last version of the 1D archive from https://lmdz.lmd.jussieu.fr/pub/'
    424            print*, '++++++++++++++++++++++++++++++'
    425            CALL abort_gcm ('mod_1D_cases_read_std','bad version of 1D directory',0)
    426          endif
    427      
    428 !-----------------------------------------------------------------------
    429 ! Checking availability of variable #i in the cas.nc file
    430 !     missing_var=1 if the variable is missing
    431 !-----------------------------------------------------------------------
    432 
    433        do i=1,nbvar3d
    434          missing_var(i)=0.
    435          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    436          print*, 'name_var(i)', name_var(i), var3didin(i)
    437          if(ierr/=NF_NOERR) then
    438            print *,'Variable manquante dans cas.nc:',i,name_var(i)
    439            ierr=NF_NOERR
    440            missing_var(i)=1
    441          else
    442 
    443 !-----------------------------------------------------------------------
    444 ! Activating keys depending on the presence of specific variables in cas.nc
    445 !-----------------------------------------------------------------------
    446 if ( 1 == 1 ) THEN
    447 ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...       
    448 !           if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
    449             if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
    450             if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'
    451             if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v'
    452     ELSE
     336    integer ntime,nlevel,k,t
     337
     338    real ap(nlevel+1),bp(nlevel+1)
     339    real zz(nlevel,ntime),zzh(nlevel+1)
     340    real pp(nlevel,ntime),pph(nlevel+1)
     341    !profils initiaux
     342    real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
     343    real pp0(nlevel)   
     344    real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
     345    real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
     346    real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime)
     347    real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime)
     348    real invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime)
     349    real ug(nlevel,ntime),vg(nlevel,ntime)
     350    real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime)
     351    real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
     352    real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
     353    real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
     354    real dtrad(nlevel,ntime)
     355    real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
     356    real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
     357    real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
     358    real flat(ntime),sens(ntime),ustar(ntime)
     359    real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
     360    real ts(ntime),tskin(ntime),ps(ntime)
     361    real orog_cas,albedo_cas,emiss_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
     362    real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
     363
     364
     365    integer nid, ierr,ierr1,ierr2,rid,i,int_test
     366    integer nbvar3d
     367    parameter(nbvar3d=78)
     368    integer var3didin(nbvar3d),missing_var(nbvar3d)
     369    character*13 name_var(1:nbvar3d)
     370
     371
     372    !      data name_var/ &
     373    !     ! coordonnees pression (n+1 niveaux) #4
     374    !     & 'coor_par_a','coor_par_b','height_h','pressure_h',& ! #1-#4
     375    !     ! coordonnees pression (n niveaux) #8
     376    !     &'temp','qv','ql','qi','u','v','tke','pressure',& ! #5-#12
     377    !     ! coordonnees pression + temps #42
     378    !     &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','temp_adv','tadvh','tadvv',& !  #13 - #25
     379    !     &'qv_adv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh',                             & ! #26 - #32
     380    !     & 'radv','radvh','radvv','radcool','q1','q2','ustress','vstress',                           & ! #33 - #40
     381    !     & 'rh','temp_nudging','qv_nudging','u_nudging','v_nudging',                                       & ! #41-45
     382    !     &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt',   & ! #46-58
     383    !     ! coordonnees temps #12
     384    !     &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
     385    !     &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',&
     386    !     ! scalaires #4
     387    !     &'o3','rugos','clay','sand'/
     388
     389
     390
     391    data name_var/ &
     392                                ! coordonnees pression (n+1 niveaux) #4
     393         'coor_par_a','coor_par_b','zf','pressure_h',& ! #1-#4
     394                                ! coordonnees pression (n niveaux) #8
     395         'ta','qv','ql','qi','ua','va','tke','pa',& ! #5-#12
     396                                ! coordonnees pression + temps #46
     397         'wa','wap','ug','vg','tnua_adv','tnua_advh','tnua_advv','tnva_adv','tnva_advh','tnva_advv','tnta_adv','tnta_advh',& !  #13 - #25
     398         'tnta_advv','tnqv_adv','tnqv_advh','tnqv_advv','thadv','thadvh','thadvv','thladvh',                             & ! #26 - #32
     399         'radv','radvh','radvv','tnta_rad','q1','q2','ustress','vstress',                           & ! #33 - #40
     400         'rh','ta_nud','qv_nud','ua_nud','va_nud',                                       & ! #41-45
     401         'zh_forc','pa_forc','tat','thetat','thetavt','thetalt','qvt','qlt','qit','rvt','uat','vat',   & ! #46-57
     402         'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va',           & ! # 58-61
     403                                ! coordonnees temps #12
     404         'tkes','hfss','hfls','ts_forc','tskin','ps_forc','ustar', &                     ! 62-68
     405                                  ! scalaires
     406         'orog','albedo','emiss','q_skin','z0','z0h',       &                    ! 69-74
     407         'O3','rugos','clay','sand'/                                                      ! 75-78
     408
     409
     410    !-----------------------------------------------------------------------
     411    ! First check that we are using a version > v2 of the 1D standard format
     412    ! use the difference between 'temp' (old version) and 'ta' (new version)
     413    !-----------------------------------------------------------------------
     414
     415
     416    ierr=NF_INQ_VARID(nid,'ta',int_test)
     417    if(ierr/=NF_NOERR) then
     418       print*, '++++++++++++++++++++++++++++++'
     419       print*, 'variable ta missing in cas.nc '
     420       print*, 'You are probably using an obsolete version of the 1D cases'
     421       print*, 'please dowload the last version of the 1D archive from https://lmdz.lmd.jussieu.fr/pub/'
     422       print*, '++++++++++++++++++++++++++++++'
     423       CALL abort_gcm ('mod_1D_cases_read_std','bad version of 1D directory',0)
     424    endif
     425
     426    !-----------------------------------------------------------------------
     427    ! Checking availability of variable #i in the cas.nc file
     428    !     missing_var=1 if the variable is missing
     429    !-----------------------------------------------------------------------
     430
     431    do i=1,nbvar3d
     432       missing_var(i)=0.
     433       ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
     434       print*, 'name_var(i)', name_var(i), var3didin(i)
     435       if(ierr/=NF_NOERR) then
     436          print *,'Variable manquante dans cas.nc:',i,name_var(i)
     437          ierr=NF_NOERR
     438          missing_var(i)=1
     439       else
     440
     441          !-----------------------------------------------------------------------
     442          ! Activating keys depending on the presence of specific variables in cas.nc
     443          !-----------------------------------------------------------------------
     444          if ( 1 == 1 ) THEN
     445             ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...       
     446             !           if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'
     447             if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'
     448             if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'
     449             if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v'
     450          ELSE
    453451             print*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF'
    454     ENDIF
    455 
    456 !-----------------------------------------------------------------------
    457 ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
    458 !-----------------------------------------------------------------------
    459            if(i.LE.4) then
    460 #ifdef NC_DOUBLE
    461            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)
    462 #else
    463            ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)
    464 #endif
    465            print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    466            if(ierr/=NF_NOERR) then
    467               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    468               stop "getvarup"
    469            endif
    470 
    471 !-----------------------------------------------------------------------
    472 !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)   
    473 !-----------------------------------------------------------------------
    474            else if(i.gt.4.and.i.LE.12) then 
    475 #ifdef NC_DOUBLE
    476            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)
    477 #else
    478            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)
    479 #endif
    480            print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    481            if(ierr/=NF_NOERR) then
    482               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    483               stop "getvarup"
    484            endif
    485          print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    486 
    487 !-----------------------------------------------------------------------
    488 !  Reading 2D tim-vertical variables  (time,nlevel,lat,lon)
    489 !  TBD : seems to be the same as above.
    490 !-----------------------------------------------------------------------
    491            else if(i.gt.12.and.i.LE.61) then
    492 #ifdef NC_DOUBLE
    493            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    494 #else
    495            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    496 #endif
    497            print *,'read2_cas(resul), on a lu ',i,name_var(i)
    498            if(ierr/=NF_NOERR) then
    499               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    500               stop "getvarup"
    501            endif
    502          print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    503 
    504 !-----------------------------------------------------------------------
    505 !  Reading 1D time variables (time,lat,lon)
    506 !-----------------------------------------------------------------------
    507            else if (i.gt.62.and.i.LE.75) then
    508 #ifdef NC_DOUBLE
    509            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)
    510 #else
    511            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)
    512 #endif
    513            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    514            if(ierr/=NF_NOERR) then
    515               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    516               stop "getvarup"
    517            endif
    518          print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
    519 
    520 !-----------------------------------------------------------------------
    521 ! Reading scalar variables (lat,lon)
    522 !-----------------------------------------------------------------------
    523            else
    524 #ifdef NC_DOUBLE
    525            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)
    526 #else
    527            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)
    528 #endif
    529            print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    530            if(ierr/=NF_NOERR) then
    531               print *,'Pb a la lecture de cas.nc: ',name_var(i)
    532               stop "getvarup"
    533            endif
    534          print*,'Lecture de la variable #i ',i,name_var(i),resul3
    535            endif
    536          endif
    537 
    538 !-----------------------------------------------------------------------
    539 ! Attributing variables
    540 !-----------------------------------------------------------------------
    541          select case(i)
    542          !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    543          ! case(2) ; bp=apbp
    544            case(3) ; zzh=apbp
    545            case(4) ; pph=apbp
    546            case(5) ; temp0=resul1    ! donnees initiales
    547            case(6) ; qv0=resul1
    548            case(7) ; ql0=resul1
    549            case(8) ; qi0=resul1
    550            case(9) ; u0=resul1
    551            case(10) ; v0=resul1
    552            case(11) ; tke0=resul1
    553            case(12) ; pp0=resul1
    554            case(13) ; vitw=resul    ! donnees indexees en nlevel,time
    555            case(14) ; omega=resul
    556            case(15) ; ug=resul
    557            case(16) ; vg=resul
    558            case(17) ; du=resul
    559            case(18) ; hu=resul
    560            case(19) ; vu=resul
    561            case(20) ; dv=resul
    562            case(21) ; hv=resul
    563            case(22) ; vv=resul
    564            case(23) ; dt=resul
    565            case(24) ; ht=resul
    566            case(25) ; vt=resul
    567            case(26) ; dq=resul
    568            case(27) ; hq=resul
    569            case(28) ; vq=resul
    570            case(29) ; dth=resul
    571            case(30) ; hth=resul
    572            case(31) ; vth=resul
    573            case(32) ; hthl=resul
    574            case(33) ; dr=resul
    575            case(34) ; hr=resul
    576            case(35) ; vr=resul
    577            case(36) ; dtrad=resul
    578            case(37) ; q1=resul
    579            case(38) ; q2=resul
    580            case(39) ; uw=resul
    581            case(40) ; vw=resul
    582            case(41) ; rh=resul
    583            case(42) ; temp_nudg=resul
    584            case(43) ; qv_nudg=resul
    585            case(44) ; u_nudg=resul
    586            case(45) ; v_nudg=resul
    587            case(46) ; zz=resul      ! donnees en time,nlevel pour profil initial
    588            case(47) ; pp=resul
    589            case(48) ; temp=resul
    590            case(49) ; theta=resul
    591            case(50) ; thv=resul
    592            case(51) ; thl=resul
    593            case(52) ; qv=resul
    594            case(53) ; ql=resul
    595            case(54) ; qi=resul
    596            case(55) ; rv=resul
    597            case(56) ; u=resul
    598            case(57) ; v=resul
    599            case(58) ; invtau_temp_nudg=resul
    600            case(59) ; invtau_qv_nudg=resul
    601            case(60) ; invtau_u_nudg=resul
    602            case(61) ; invtau_v_nudg=resul
    603            case(62) ; tkes=resul2   ! donnees indexees en time
    604            case(63) ; sens=resul2
    605            case(64) ; flat=resul2
    606            case(65) ; ts=resul2
    607            case(66) ; ps=resul2
    608            case(67) ; ustar=resul2
    609            case(68) ; orog_cas=resul3      ! constantes
    610            case(69) ; albedo_cas=resul3
    611            case(70) ; emiss_cas=resul3
    612            case(71) ; t_skin_cas=resul3
    613            case(72) ; q_skin_cas=resul3
    614            case(73) ; mom_rough=resul3
    615            case(74) ; heat_rough=resul3
    616            case(75) ; o3_cas=resul3       
    617            case(76) ; rugos_cas=resul3
    618            case(77) ; clay_cas=resul3
    619            case(78) ; sand_cas=resul3
    620          end select
    621          resul=0.
    622          resul1=0.
    623          resul2=0.
    624          resul3=0.
     452          ENDIF
     453
     454          !-----------------------------------------------------------------------
     455          ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
     456          !-----------------------------------------------------------------------
     457          if(i.LE.4) then
     458             ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
     459             print *,'read_SCM(apbp), on a lu ',i,name_var(i)
     460             if(ierr/=NF_NOERR) then
     461                print *,'B Pb a la lecture de cas.nc: ',name_var(i)
     462                stop "getvarup"
     463             endif
     464
     465             !-----------------------------------------------------------------------
     466             !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)   
     467             !-----------------------------------------------------------------------
     468          else if(i.gt.4.and.i.LE.12) then 
     469             ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
     470             print *,'read_SCM(resul1), on a lu ',i,name_var(i)
     471             if(ierr/=NF_NOERR) then
     472                print *,'C Pb a la lecture de cas.nc: ',name_var(i)
     473                stop "getvarup"
     474             endif
     475             print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
     476
     477             !-----------------------------------------------------------------------
     478             !  Reading 2D tim-vertical variables  (time,nlevel,lat,lon)
     479             !  TBD : seems to be the same as above.
     480             !-----------------------------------------------------------------------
     481          else if(i.gt.12.and.i.LE.61) then
     482             ierr = NF90_GET_VAR(nid,var3didin(i),resul)
     483             print *,'read_SCM(resul), on a lu ',i,name_var(i)
     484             if(ierr/=NF_NOERR) then
     485                print *,'D Pb a la lecture de cas.nc: ',name_var(i)
     486                stop "getvarup"
     487             endif
     488             print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
     489
     490             !-----------------------------------------------------------------------
     491             !  Reading 1D time variables (time,lat,lon)
     492             !-----------------------------------------------------------------------
     493          else if (i.gt.62.and.i.LE.75) then
     494             ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
     495             print *,'read_SCM(resul2), on a lu ',i,name_var(i)
     496             if(ierr/=NF_NOERR) then
     497                print *,'E Pb a la lecture de cas.nc: ',name_var(i)
     498                stop "getvarup"
     499             endif
     500             print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
     501
     502             !-----------------------------------------------------------------------
     503             ! Reading scalar variables (lat,lon)
     504             !-----------------------------------------------------------------------
     505          else
     506             ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
     507             print *,'read_SCM(resul3), on a lu ',i,name_var(i)
     508             if(ierr/=NF_NOERR) then
     509                print *,'F Pb a la lecture de cas.nc: ',name_var(i)
     510                stop "getvarup"
     511             endif
     512             print*,'Lecture de la variable #i ',i,name_var(i),resul3
     513          endif
     514       endif
     515
     516       !-----------------------------------------------------------------------
     517       ! Attributing variables
     518       !-----------------------------------------------------------------------
     519       select case(i)
     520          !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
     521          ! case(2) ; bp=apbp
     522       case(3) ; zzh=apbp
     523       case(4) ; pph=apbp
     524       case(5) ; temp0=resul1    ! donnees initiales
     525       case(6) ; qv0=resul1
     526       case(7) ; ql0=resul1
     527       case(8) ; qi0=resul1
     528       case(9) ; u0=resul1
     529       case(10) ; v0=resul1
     530       case(11) ; tke0=resul1
     531       case(12) ; pp0=resul1
     532       case(13) ; vitw=resul    ! donnees indexees en nlevel,time
     533       case(14) ; omega=resul
     534       case(15) ; ug=resul
     535       case(16) ; vg=resul
     536       case(17) ; du=resul
     537       case(18) ; hu=resul
     538       case(19) ; vu=resul
     539       case(20) ; dv=resul
     540       case(21) ; hv=resul
     541       case(22) ; vv=resul
     542       case(23) ; dt=resul
     543       case(24) ; ht=resul
     544       case(25) ; vt=resul
     545       case(26) ; dq=resul
     546       case(27) ; hq=resul
     547       case(28) ; vq=resul
     548       case(29) ; dth=resul
     549       case(30) ; hth=resul
     550       case(31) ; vth=resul
     551       case(32) ; hthl=resul
     552       case(33) ; dr=resul
     553       case(34) ; hr=resul
     554       case(35) ; vr=resul
     555       case(36) ; dtrad=resul
     556       case(37) ; q1=resul
     557       case(38) ; q2=resul
     558       case(39) ; uw=resul
     559       case(40) ; vw=resul
     560       case(41) ; rh=resul
     561       case(42) ; temp_nudg=resul
     562       case(43) ; qv_nudg=resul
     563       case(44) ; u_nudg=resul
     564       case(45) ; v_nudg=resul
     565       case(46) ; zz=resul      ! donnees en time,nlevel pour profil initial
     566       case(47) ; pp=resul
     567       case(48) ; temp=resul
     568       case(49) ; theta=resul
     569       case(50) ; thv=resul
     570       case(51) ; thl=resul
     571       case(52) ; qv=resul
     572       case(53) ; ql=resul
     573       case(54) ; qi=resul
     574       case(55) ; rv=resul
     575       case(56) ; u=resul
     576       case(57) ; v=resul
     577       case(58) ; invtau_temp_nudg=resul
     578       case(59) ; invtau_qv_nudg=resul
     579       case(60) ; invtau_u_nudg=resul
     580       case(61) ; invtau_v_nudg=resul
     581       case(62) ; tkes=resul2   ! donnees indexees en time
     582       case(63) ; sens=resul2
     583       case(64) ; flat=resul2
     584       case(65) ; ts=resul2
     585       case(66) ; tskin=resul2       
     586       case(67) ; ps=resul2
     587       case(68) ; ustar=resul2
     588       case(69) ; orog_cas=resul3      ! constantes
     589       case(70) ; albedo_cas=resul3
     590       case(71) ; emiss_cas=resul3
     591       case(72) ; q_skin_cas=resul3
     592       case(73) ; mom_rough=resul3
     593       case(74) ; heat_rough=resul3
     594       case(75) ; o3_cas=resul3       
     595       case(76) ; rugos_cas=resul3
     596       case(77) ; clay_cas=resul3
     597       case(78) ; sand_cas=resul3
     598       end select
     599       resul=0.
     600       resul1=0.
     601       resul2=0.
     602       resul3=0.
     603    enddo
     604    print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
     605    print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
     606
     607    !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
     608    do t=1,ntime
     609       do k=1,nlevel
     610          temp(k,t)=temp0(k)
     611          qv(k,t)=qv0(k)
     612          ql(k,t)=ql0(k)
     613          qi(k,t)=qi0(k)
     614          u(k,t)=u0(k)
     615          v(k,t)=v0(k)
     616          tke(k,t)=tke0(k)
    625617       enddo
    626          print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
    627          print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
    628 
    629 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
    630        do t=1,ntime
    631           do k=1,nlevel
    632              temp(k,t)=temp0(k)
    633              qv(k,t)=qv0(k)
    634              ql(k,t)=ql0(k)
    635              qi(k,t)=qi0(k)
    636              u(k,t)=u0(k)
    637              v(k,t)=v0(k)
    638              tke(k,t)=tke0(k)
    639           enddo
    640        enddo
    641        !!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W
    642        !!!omega=-vitw*pres*rg/(rd*temp)
    643 !-----------------------------------------------------------------------
    644 
    645          return
    646          END SUBROUTINE read_SCM
    647 !======================================================================
    648 
    649 !======================================================================
    650 
    651 !**********************************************************************************************
    652 
    653 !**********************************************************************************************
    654         SUBROUTINE interp_case_time_std(day,day1,annee_ref                           &
    655 !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
    656      &         ,nt_cas,nlev_cas                                                   &
    657      &         ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
    658      &         ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
    659      &         ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas     &
    660      &         ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas     &
    661      &         ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas             &
    662      &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
    663      &         ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
    664      &         ,lat_cas,sens_cas,ustar_cas                                        &
    665      &         ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                               &
    666 !
    667      &         ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    668      &         ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    669      &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
    670      &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas     &
    671      &         ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas     &     
    672      &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
    673      &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
    674      &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
    675      &         ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
    676      &         ,lat_prof_cas,sens_prof_cas                                        &
    677      &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    678 
    679 
    680 
    681 
    682 
    683 
    684        implicit none
    685 
    686 !---------------------------------------------------------------------------------------
    687 ! Time interpolation of a 2D field to the timestep corresponding to day
    688 !
    689 ! day: current julian day (e.g. 717538.2)
    690 ! day1: first day of the simulation
    691 ! nt_cas: total nb of data in the forcing
    692 ! pdt_cas: total time interval (in sec) between 2 forcing data
    693 !---------------------------------------------------------------------------------------
     618    enddo
     619!!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W
     620!!!omega=-vitw*pres*rg/(rd*temp)
     621    !-----------------------------------------------------------------------
     622
     623    return
     624  END SUBROUTINE read_SCM
     625  !======================================================================
     626
     627  !======================================================================
     628
     629  !**********************************************************************************************
     630
     631  !**********************************************************************************************
     632  SUBROUTINE interp_case_time_std(day,day1,annee_ref                           &
     633       !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
     634       ,nt_cas,nlev_cas                                                   &
     635       ,ts_cas,tskin_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
     636       ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
     637       ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas     &
     638       ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas     &
     639       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas             &
     640       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
     641       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
     642       ,lat_cas,sens_cas,ustar_cas                                        &
     643       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                               &
     644       !
     645       ,ts_prof_cas,tskin_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
     646       ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
     647       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
     648       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas     &
     649       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas     &     
     650       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
     651       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
     652       ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
     653       ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
     654       ,lat_prof_cas,sens_prof_cas                                        &
     655       ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
     656
     657
     658
     659
     660
     661
     662    implicit none
     663
     664    !---------------------------------------------------------------------------------------
     665    ! Time interpolation of a 2D field to the timestep corresponding to day
     666    !
     667    ! day: current julian day (e.g. 717538.2)
     668    ! day1: first day of the simulation
     669    ! nt_cas: total nb of data in the forcing
     670    ! pdt_cas: total time interval (in sec) between 2 forcing data
     671    !---------------------------------------------------------------------------------------
    694672
    695673#include "compar1d.h"
    696674#include "date_cas.h"
    697675
    698 ! inputs:
    699         integer annee_ref
    700         integer nt_cas,nlev_cas
    701         real day, day1,day_cas
    702         real ts_cas(nt_cas),ps_cas(nt_cas)
    703         real plev_cas(nlev_cas,nt_cas)
    704         real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
    705         real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
    706         real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
    707         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    708         real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    709         real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
    710         real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
    711 
    712         real invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
    713         real invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
    714 
    715         real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
    716         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    717         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    718         real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    719         real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
    720         real dtrad_cas(nlev_cas,nt_cas)
    721         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    722         real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
    723         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    724         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    725 
    726 ! outputs:
    727         real plev_prof_cas(nlev_cas)
    728         real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
    729         real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    730         real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    731         real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    732         real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
    733         real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
    734 
    735         real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
    736         real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
    737 
    738         real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
    739         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    740         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    741         real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    742         real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    743         real dtrad_prof_cas(nlev_cas)
    744         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    745         real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas
    746         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    747 ! local:
    748         integer it_cas1, it_cas2,k
    749         real timeit,time_cas1,time_cas2,frac
    750 
    751 
    752         print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    753 !       do k=1,nlev_cas
    754 !       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
    755 !       enddo
    756 
    757 ! On teste si la date du cas AMMA est correcte.
    758 ! C est pour memoire car en fait les fichiers .def
    759 ! sont censes etre corrects.
    760 ! A supprimer a terme (MPL 20150623)
    761 !     if ((forcing_type.eq.10).and.(1.eq.0)) then
    762 ! Check that initial day of the simulation consistent with AMMA case:
    763 !      if (annee_ref.ne.2006) then
    764 !       print*,'Pour AMMA, annee_ref doit etre 2006'
    765 !       print*,'Changer annee_ref dans run.def'
    766 !       stop
    767 !      endif
    768 !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
    769 !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    770 !       print*,'Changer dayref dans run.def'
    771 !       stop
    772 !      endif
    773 !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
    774 !       print*,'AMMA a fini le 11 juillet'
    775 !       print*,'Changer dayref ou nday dans run.def'
    776 !       stop
    777 !      endif
    778 !      endif
    779 
    780 ! Determine timestep relative to the 1st day:
    781 !       timeit=(day-day1)*86400.
    782 !       if (annee_ref.eq.1992) then
    783 !        timeit=(day-day_cas)*86400.
    784 !       else
    785 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    786 !       endif
    787       timeit=(day-day_ju_ini_cas)*86400
    788       print *,'day=',day
    789       print *,'day_ju_ini_cas=',day_ju_ini_cas
    790       print *,'pdt_cas=',pdt_cas
    791       print *,'timeit=',timeit
    792       print *,'nt_cas=',nt_cas
    793 
    794 ! Determine the closest observation times:
    795 !       it_cas1=INT(timeit/pdt_cas)+1
    796 !       it_cas2=it_cas1 + 1
    797 !       time_cas1=(it_cas1-1)*pdt_cas
    798 !       time_cas2=(it_cas2-1)*pdt_cas
    799 
    800        it_cas1=INT(timeit/pdt_cas)+1
    801        IF (it_cas1 .EQ. nt_cas) THEN
     676    ! inputs:
     677    integer annee_ref
     678    integer nt_cas,nlev_cas
     679    real day, day1,day_cas
     680    real ts_cas(nt_cas),tskin_cas(nt_cas),ps_cas(nt_cas)
     681    real plev_cas(nlev_cas,nt_cas)
     682    real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas)
     683    real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas)
     684    real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
     685    real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
     686    real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
     687    real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)
     688    real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)
     689
     690    real invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)
     691    real invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)
     692
     693    real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas)
     694    real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
     695    real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
     696    real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
     697    real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
     698    real dtrad_cas(nlev_cas,nt_cas)
     699    real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
     700    real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas)
     701    real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
     702    real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
     703
     704    ! outputs:
     705    real plev_prof_cas(nlev_cas)
     706    real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
     707    real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     708    real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     709    real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
     710    real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
     711    real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
     712
     713    real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
     714    real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
     715
     716    real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
     717    real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     718    real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     719    real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
     720    real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     721    real dtrad_prof_cas(nlev_cas)
     722    real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     723    real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,tskin_prof_cas,ps_prof_cas,ustar_prof_cas
     724    real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
     725    ! local:
     726    integer it_cas1, it_cas2,k
     727    real timeit,time_cas1,time_cas2,frac
     728
     729
     730    print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
     731    !       do k=1,nlev_cas
     732    !       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
     733    !       enddo
     734
     735    ! On teste si la date du cas AMMA est correcte.
     736    ! C est pour memoire car en fait les fichiers .def
     737    ! sont censes etre corrects.
     738    ! A supprimer a terme (MPL 20150623)
     739    !     if ((forcing_type.eq.10).and.(1.eq.0)) then
     740    ! Check that initial day of the simulation consistent with AMMA case:
     741    !      if (annee_ref.ne.2006) then
     742    !       print*,'Pour AMMA, annee_ref doit etre 2006'
     743    !       print*,'Changer annee_ref dans run.def'
     744    !       stop
     745    !      endif
     746    !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
     747    !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
     748    !       print*,'Changer dayref dans run.def'
     749    !       stop
     750    !      endif
     751    !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
     752    !       print*,'AMMA a fini le 11 juillet'
     753    !       print*,'Changer dayref ou nday dans run.def'
     754    !       stop
     755    !      endif
     756    !      endif
     757
     758    ! Determine timestep relative to the 1st day:
     759    !       timeit=(day-day1)*86400.
     760    !       if (annee_ref.eq.1992) then
     761    !        timeit=(day-day_cas)*86400.
     762    !       else
     763    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     764    !       endif
     765    timeit=(day-day_ju_ini_cas)*86400
     766    print *,'day=',day
     767    print *,'day_ju_ini_cas=',day_ju_ini_cas
     768    print *,'pdt_cas=',pdt_cas
     769    print *,'timeit=',timeit
     770    print *,'nt_cas=',nt_cas
     771
     772    ! Determine the closest observation times:
     773    !       it_cas1=INT(timeit/pdt_cas)+1
     774    !       it_cas2=it_cas1 + 1
     775    !       time_cas1=(it_cas1-1)*pdt_cas
     776    !       time_cas2=(it_cas2-1)*pdt_cas
     777
     778    it_cas1=INT(timeit/pdt_cas)+1
     779    IF (it_cas1 .EQ. nt_cas) THEN
    802780       it_cas2=it_cas1
    803        ELSE
     781    ELSE
    804782       it_cas2=it_cas1 + 1
    805        ENDIF
    806        time_cas1=(it_cas1-1)*pdt_cas
    807        time_cas2=(it_cas2-1)*pdt_cas
    808 !     print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
    809 !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    810 
    811        if (it_cas1 .gt. nt_cas) then
    812         write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    813      &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    814         stop
    815        endif
    816 
    817 ! time interpolation:
    818        IF (it_cas1 .EQ. it_cas2) THEN
    819           frac=0.
    820        ELSE
    821           frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    822           frac=max(frac,0.0)
    823        ENDIF
    824 
    825        lat_prof_cas = lat_cas(it_cas2)                                   &
    826      &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    827        sens_prof_cas = sens_cas(it_cas2)                                 &
    828      &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    829        tkes_prof_cas = tkes_cas(it_cas2)                                   &
    830      &          -frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1))
    831        ts_prof_cas = ts_cas(it_cas2)                                     &
    832      &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    833        ps_prof_cas = ps_cas(it_cas2)                                     &
    834      &          -frac*(ps_cas(it_cas2)-ps_cas(it_cas1))
    835        ustar_prof_cas = ustar_cas(it_cas2)                               &
    836      &          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    837 
    838        do k=1,nlev_cas
    839         plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
    840      &          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    841         t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
    842      &          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    843         !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
    844         theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
    845      &          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
    846         thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
    847      &          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
    848         thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
    849      &          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
    850         qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
    851      &          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
    852         ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
    853      &          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
    854         qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
    855      &          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
    856         u_prof_cas(k) = u_cas(k,it_cas2)                                 &
    857      &          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    858         v_prof_cas(k) = v_cas(k,it_cas2)                                 &
    859      &          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    860         ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    861      &          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    862         vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    863      &          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    864         temp_nudg_prof_cas(k) = temp_nudg_cas(k,it_cas2)                    &
    865      &          -frac*(temp_nudg_cas(k,it_cas2)-temp_nudg_cas(k,it_cas1))
    866         qv_nudg_prof_cas(k) = qv_nudg_cas(k,it_cas2)                        &
    867      &          -frac*(qv_nudg_cas(k,it_cas2)-qv_nudg_cas(k,it_cas1))
    868         u_nudg_prof_cas(k) = u_nudg_cas(k,it_cas2)                          &
    869      &          -frac*(u_nudg_cas(k,it_cas2)-u_nudg_cas(k,it_cas1))
    870         v_nudg_prof_cas(k) = v_nudg_cas(k,it_cas2)                          &
    871      &          -frac*(v_nudg_cas(k,it_cas2)-v_nudg_cas(k,it_cas1))
    872         invtau_temp_nudg_prof_cas(k) = invtau_temp_nudg_cas(k,it_cas2)                    &
    873      &          -frac*(invtau_temp_nudg_cas(k,it_cas2)-invtau_temp_nudg_cas(k,it_cas1))
    874         invtau_qv_nudg_prof_cas(k) = invtau_qv_nudg_cas(k,it_cas2)                        &
    875      &          -frac*(invtau_qv_nudg_cas(k,it_cas2)-invtau_qv_nudg_cas(k,it_cas1))
    876         invtau_u_nudg_prof_cas(k) = invtau_u_nudg_cas(k,it_cas2)                          &
    877      &          -frac*(invtau_u_nudg_cas(k,it_cas2)-invtau_u_nudg_cas(k,it_cas1))
    878         invtau_v_nudg_prof_cas(k) = invtau_v_nudg_cas(k,it_cas2)                          &
    879      &          -frac*(invtau_v_nudg_cas(k,it_cas2)-invtau_v_nudg_cas(k,it_cas1))
    880         vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
    881      &          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    882         omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
    883      &          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
    884         tke_prof_cas(k) = tke_cas(k,it_cas2)                         &
    885      &          -frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1))
    886         du_prof_cas(k) = du_cas(k,it_cas2)                               &
    887      &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    888         hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
    889      &          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    890         vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
    891      &          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    892         dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
    893      &          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    894         hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
    895      &          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    896         vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
    897      &          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    898         dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
    899      &          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    900         ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
    901      &          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    902         vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
    903      &          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    904         dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
    905      &          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
    906         hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
    907      &          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
    908         vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
    909      &          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
    910         dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
    911      &          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    912         dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
    913      &          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    914         hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
    915      &          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    916         vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
    917      &          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
     783    ENDIF
     784    time_cas1=(it_cas1-1)*pdt_cas
     785    time_cas2=(it_cas2-1)*pdt_cas
     786    !     print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
     787    !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
     788
     789    if (it_cas1 .gt. nt_cas) then
     790       write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
     791            ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
     792       stop
     793    endif
     794
     795    ! time interpolation:
     796    IF (it_cas1 .EQ. it_cas2) THEN
     797       frac=0.
     798    ELSE
     799       frac=(time_cas2-timeit)/(time_cas2-time_cas1)
     800       frac=max(frac,0.0)
     801    ENDIF
     802
     803    lat_prof_cas = lat_cas(it_cas2)                                   &
     804         -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
     805    sens_prof_cas = sens_cas(it_cas2)                                 &
     806         -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
     807    tkes_prof_cas = tkes_cas(it_cas2)                                   &
     808         -frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1))
     809    ts_prof_cas = ts_cas(it_cas2)                                     &
     810         -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
     811    tskin_prof_cas = tskin_cas(it_cas2)                                     &
     812         -frac*(tskin_cas(it_cas2)-tskin_cas(it_cas1))
     813    ps_prof_cas = ps_cas(it_cas2)                                     &
     814         -frac*(ps_cas(it_cas2)-ps_cas(it_cas1))
     815    ustar_prof_cas = ustar_cas(it_cas2)                               &
     816         -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
     817
     818    do k=1,nlev_cas
     819       plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
     820            -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
     821       t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
     822            -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
     823       !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
     824       theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
     825            -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
     826       thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
     827            -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
     828       thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
     829            -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
     830       qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
     831            -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
     832       ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
     833            -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
     834       qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
     835            -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
     836       u_prof_cas(k) = u_cas(k,it_cas2)                                 &
     837            -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
     838       v_prof_cas(k) = v_cas(k,it_cas2)                                 &
     839            -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
     840       ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
     841            -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
     842       vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
     843            -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
     844       temp_nudg_prof_cas(k) = temp_nudg_cas(k,it_cas2)                    &
     845            -frac*(temp_nudg_cas(k,it_cas2)-temp_nudg_cas(k,it_cas1))
     846       qv_nudg_prof_cas(k) = qv_nudg_cas(k,it_cas2)                        &
     847            -frac*(qv_nudg_cas(k,it_cas2)-qv_nudg_cas(k,it_cas1))
     848       u_nudg_prof_cas(k) = u_nudg_cas(k,it_cas2)                          &
     849            -frac*(u_nudg_cas(k,it_cas2)-u_nudg_cas(k,it_cas1))
     850       v_nudg_prof_cas(k) = v_nudg_cas(k,it_cas2)                          &
     851            -frac*(v_nudg_cas(k,it_cas2)-v_nudg_cas(k,it_cas1))
     852       invtau_temp_nudg_prof_cas(k) = invtau_temp_nudg_cas(k,it_cas2)                    &
     853            -frac*(invtau_temp_nudg_cas(k,it_cas2)-invtau_temp_nudg_cas(k,it_cas1))
     854       invtau_qv_nudg_prof_cas(k) = invtau_qv_nudg_cas(k,it_cas2)                        &
     855            -frac*(invtau_qv_nudg_cas(k,it_cas2)-invtau_qv_nudg_cas(k,it_cas1))
     856       invtau_u_nudg_prof_cas(k) = invtau_u_nudg_cas(k,it_cas2)                          &
     857            -frac*(invtau_u_nudg_cas(k,it_cas2)-invtau_u_nudg_cas(k,it_cas1))
     858       invtau_v_nudg_prof_cas(k) = invtau_v_nudg_cas(k,it_cas2)                          &
     859            -frac*(invtau_v_nudg_cas(k,it_cas2)-invtau_v_nudg_cas(k,it_cas1))
     860       vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
     861            -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
     862       omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
     863            -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
     864       tke_prof_cas(k) = tke_cas(k,it_cas2)                         &
     865            -frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1))
     866       du_prof_cas(k) = du_cas(k,it_cas2)                               &
     867            -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
     868       hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
     869            -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
     870       vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
     871            -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
     872       dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
     873            -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
     874       hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
     875            -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
     876       vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
     877            -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
     878       dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
     879            -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
     880       ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
     881            -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
     882       vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
     883            -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
     884       dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
     885            -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
     886       hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
     887            -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
     888       vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
     889            -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
     890       dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
     891            -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
     892       dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
     893            -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
     894       hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
     895            -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
     896       vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
     897            -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    918898       uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
    919      &          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
     899            -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    920900       vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
    921      &          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
     901            -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    922902       q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
    923      &          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
     903            -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    924904       q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
    925      &          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    926         enddo
    927 
    928         return
    929         END SUBROUTINE interp_case_time_std
    930 
    931 !**********************************************************************************************
    932 !=====================================================================
    933        SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                           &
    934      &         ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas                                       &
    935      &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                              &
    936      &         ,ug_prof_cas,vg_prof_cas                                                                &
    937      &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                    &
    938      &         ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &     
    939      &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                              &
    940      &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                &
    941      &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
    942      &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
    943 !
    944      &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
    945      &         ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &
    946      &         ,ug_mod_cas,vg_mod_cas                                                                  &
    947      &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                        &
    948      &         ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas                        &     
    949      &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                    &
    950      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                      &
    951      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas        &
    952      &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
    953  
    954        implicit none
    955  
     905            -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
     906    enddo
     907
     908    return
     909  END SUBROUTINE interp_case_time_std
     910
     911  !**********************************************************************************************
     912  !=====================================================================
     913  SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                           &
     914       ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas                                       &
     915       ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                              &
     916       ,ug_prof_cas,vg_prof_cas                                                                &
     917       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                    &
     918       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &     
     919       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                              &
     920       ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                &
     921       ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
     922       ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
     923       !
     924       ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
     925       ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &
     926       ,ug_mod_cas,vg_mod_cas                                                                  &
     927       ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                        &
     928       ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas                        &     
     929       ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                    &
     930       ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                      &
     931       ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas        &
     932       ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     933
     934    implicit none
     935
    956936#include "YOMCST.h"
    957937#include "dimensions.h"
    958938
    959 !-------------------------------------------------------------------------
    960 ! Vertical interpolation of generic case forcing data onto mod_casel levels
    961 !-------------------------------------------------------------------------
    962  
    963        integer nlevmax
    964        parameter (nlevmax=41)
    965        integer nlev_cas,mxcalc
    966 !       real play(llm), plev_prof(nlevmax)
    967 !       real t_prof(nlevmax),q_prof(nlevmax)
    968 !       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
    969 !       real ht_prof(nlevmax),vt_prof(nlevmax)
    970 !       real hq_prof(nlevmax),vq_prof(nlevmax)
    971  
    972        real play(llm), plev(llm+1), plev_prof_cas(nlev_cas)
    973        real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
    974        real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    975        real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    976        real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
    977        real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
    978        real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
    979        real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
    980        real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
    981 
    982        real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    983        real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    984        real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
    985        real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    986        real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    987  
    988        real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
    989        real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
    990        real u_mod_cas(llm),v_mod_cas(llm)
    991        real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
    992        real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
    993        real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
    994        real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
    995        real invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
    996        real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
    997        real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
    998        real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
    999        real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
    1000        real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
    1001  
    1002        integer l,k,k1,k2
    1003        real frac,frac1,frac2,fact
    1004  
    1005 
    1006 
    1007 ! for variables defined at the middle of layers
    1008 
    1009        do l = 1, llm
    1010 
    1011         if (play(l).ge.plev_prof_cas(nlev_cas)) then
    1012  
    1013         mxcalc=l
    1014 !        print *,'debut interp2, mxcalc=',mxcalc
    1015          k1=0
    1016          k2=0
    1017 
    1018          if (play(l).le.plev_prof_cas(1)) then
    1019 
    1020          do k = 1, nlev_cas-1
    1021           if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
    1022             k1=k
    1023             k2=k+1
    1024           endif
    1025          enddo
    1026 
    1027          if (k1.eq.0 .or. k2.eq.0) then
    1028           write(*,*) 'PB! k1, k2 = ',k1,k2
    1029           write(*,*) 'l,play(l) = ',l,play(l)/100
    1030          do k = 1, nlev_cas-1
    1031           write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
    1032          enddo
    1033          endif
    1034 
    1035 
    1036 
    1037          frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
    1038          
    1039          t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
    1040          theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
    1041          if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
    1042          thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
    1043          thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
    1044          qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))
    1045          ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))
    1046          qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))
    1047          u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
    1048          v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
    1049          ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
    1050          vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
    1051          temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1))
    1052          qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1))
    1053          u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1))
    1054          v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1))
    1055 
    1056          invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(k2) - frac*(invtau_temp_nudg_prof_cas(k2)-invtau_temp_nudg_prof_cas(k1))
    1057          invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(k2) - frac*(invtau_qv_nudg_prof_cas(k2)-invtau_qv_nudg_prof_cas(k1))
    1058          invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(k2) - frac*(invtau_u_nudg_prof_cas(k2)-invtau_u_nudg_prof_cas(k1))
    1059          invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(k2) - frac*(invtau_v_nudg_prof_cas(k2)-invtau_v_nudg_prof_cas(k1))
    1060 
    1061          w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
    1062          omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))
    1063          du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
    1064          hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
    1065          vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
    1066          dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
    1067          hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
    1068          vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
    1069          dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
    1070          ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
    1071          vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
    1072          dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))
    1073          hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))
    1074          vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))
    1075          dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
    1076          hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
    1077          vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
    1078          dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
    1079      
    1080          else !play>plev_prof_cas(1)
    1081 
    1082          k1=1
    1083          k2=2
    1084          print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)
    1085          frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
    1086          frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
    1087          t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
    1088          theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
    1089          if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
    1090          thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
    1091          thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
    1092          qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2)
    1093          ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2)
    1094          qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2)
    1095          u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
    1096          v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
    1097          ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
    1098          vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
    1099          temp_nudg_mod_cas(l)= frac1*temp_nudg_prof_cas(k1) - frac2*temp_nudg_prof_cas(k2)
    1100          qv_nudg_mod_cas(l)= frac1*qv_nudg_prof_cas(k1) - frac2*qv_nudg_prof_cas(k2)
    1101          u_nudg_mod_cas(l)= frac1*u_nudg_prof_cas(k1) - frac2*u_nudg_prof_cas(k2)
    1102          v_nudg_mod_cas(l)= frac1*v_nudg_prof_cas(k1) - frac2*v_nudg_prof_cas(k2)
    1103 
    1104          invtau_temp_nudg_mod_cas(l)= frac1*invtau_temp_nudg_prof_cas(k1) - frac2*invtau_temp_nudg_prof_cas(k2)
    1105          invtau_qv_nudg_mod_cas(l)= frac1*invtau_qv_nudg_prof_cas(k1) - frac2*invtau_qv_nudg_prof_cas(k2)
    1106          invtau_u_nudg_mod_cas(l)= frac1*invtau_u_nudg_prof_cas(k1) - frac2*invtau_u_nudg_prof_cas(k2)
    1107          invtau_v_nudg_mod_cas(l)= frac1*invtau_v_nudg_prof_cas(k1) - frac2*invtau_v_nudg_prof_cas(k2)
    1108 
    1109          w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
    1110          omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2)
    1111          du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
    1112          hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
    1113          vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
    1114          dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
    1115          hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
    1116          vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
    1117          dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
    1118          ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
    1119          vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
    1120          dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2)
    1121          hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2)
    1122          vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2)
    1123          dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
    1124          hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
    1125          vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
    1126          dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)
    1127 
    1128          endif ! play.le.plev_prof_cas(1)
    1129 
    1130         else ! above max altitude of forcing file
    1131  
    1132 !jyg
    1133          fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
    1134          fact = max(fact,0.)                                           !jyg
    1135          fact = exp(-fact)                                             !jyg
    1136          t_mod_cas(l)= t_prof_cas(nlev_cas)                            !jyg
    1137          theta_mod_cas(l)= th_prof_cas(nlev_cas)                       !jyg
    1138          thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
    1139          thl_mod_cas(l)= thl_prof_cas(nlev_cas)                        !jyg
    1140          qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact                     !jyg
    1141          ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact                     !jyg
    1142          qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact                     !jyg
    1143          u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                       !jyg
    1144          v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                       !jyg
    1145          ug_mod_cas(l)= ug_prof_cas(nlev_cas)                          !jyg
    1146          vg_mod_cas(l)= vg_prof_cas(nlev_cas)                          !jyg
    1147          temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas)            !jyg
    1148          qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas)                !jyg
    1149          u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas)                  !jyg
    1150          v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas)                  !jyg
    1151 
    1152          invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(nlev_cas)            !jyg
    1153          invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(nlev_cas)                !jyg
    1154          invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(nlev_cas)                  !jyg
    1155          invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(nlev_cas)                  !jyg
    1156 
    1157          thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
    1158          w_mod_cas(l)= 0.0                                             !jyg
    1159          omega_mod_cas(l)= 0.0                                         !jyg
    1160          du_mod_cas(l)= du_prof_cas(nlev_cas)*fact
    1161          hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                     !jyg
    1162          vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                     !jyg
    1163          dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact
    1164          hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                     !jyg
    1165          vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                     !jyg
    1166          dt_mod_cas(l)= dt_prof_cas(nlev_cas)
    1167          ht_mod_cas(l)= ht_prof_cas(nlev_cas)                          !jyg
    1168          vt_mod_cas(l)= vt_prof_cas(nlev_cas)                          !jyg
    1169          dth_mod_cas(l)= dth_prof_cas(nlev_cas)
    1170          hth_mod_cas(l)= hth_prof_cas(nlev_cas)                        !jyg
    1171          vth_mod_cas(l)= vth_prof_cas(nlev_cas)                        !jyg
    1172          dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact
    1173          hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                     !jyg
    1174          vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                     !jyg
    1175          dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact               !jyg
    1176  
    1177         endif ! play
    1178  
    1179        enddo ! l
    1180 
    1181 ! for variables defined at layer interfaces (EV):
    1182 
    1183 
    1184        do l = 1, llm+1
    1185 
    1186         if (plev(l).ge.plev_prof_cas(nlev_cas)) then
    1187 
    1188          mxcalc=l
    1189          k1=0
    1190          k2=0
    1191 
    1192          if (plev(l).le.plev_prof_cas(1)) then
    1193 
    1194          do k = 1, nlev_cas-1
    1195           if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then
    1196             k1=k
    1197             k2=k+1
    1198           endif
    1199          enddo
    1200 
    1201          if (k1.eq.0 .or. k2.eq.0) then
    1202           write(*,*) 'PB! k1, k2 = ',k1,k2
    1203           write(*,*) 'l,plev(l) = ',l,plev(l)/100
    1204          do k = 1, nlev_cas-1
    1205           write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
    1206          enddo
    1207          endif
    1208 
    1209          frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
    1210          tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1))
    1211          else !play>plev_prof_cas(1)
    1212          k1=1
    1213          k2=2
    1214          tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2)
    1215 
    1216          endif ! plev.le.plev_prof_cas(1)
    1217 
    1218         else ! above max altitude of forcing file
    1219 
    1220          tke_mod_cas(l)=0.0
    1221 
    1222         endif ! plev
    1223 
    1224        enddo ! l
    1225 
    1226 
    1227 
    1228           return
    1229           end SUBROUTINE interp2_case_vertical_std
    1230 !*****************************************************************************
     939    !-------------------------------------------------------------------------
     940    ! Vertical interpolation of generic case forcing data onto mod_casel levels
     941    !-------------------------------------------------------------------------
     942
     943    integer nlevmax
     944    parameter (nlevmax=41)
     945    integer nlev_cas,mxcalc
     946    !       real play(llm), plev_prof(nlevmax)
     947    !       real t_prof(nlevmax),q_prof(nlevmax)
     948    !       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
     949    !       real ht_prof(nlevmax),vt_prof(nlevmax)
     950    !       real hq_prof(nlevmax),vq_prof(nlevmax)
     951
     952    real play(llm), plev(llm+1), plev_prof_cas(nlev_cas)
     953    real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
     954    real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     955    real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     956    real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas)
     957    real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)
     958    real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)
     959    real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)
     960    real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)
     961
     962    real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     963    real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     964    real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
     965    real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     966    real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     967
     968    real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
     969    real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
     970    real u_mod_cas(llm),v_mod_cas(llm)
     971    real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1)
     972    real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm)
     973    real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm)
     974    real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm)
     975    real invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm)
     976    real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
     977    real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
     978    real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
     979    real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
     980    real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
     981
     982    integer l,k,k1,k2
     983    real frac,frac1,frac2,fact
     984
     985
     986
     987    ! for variables defined at the middle of layers
     988
     989    do l = 1, llm
     990
     991       if (play(l).ge.plev_prof_cas(nlev_cas)) then
     992
     993          mxcalc=l
     994          !        print *,'debut interp2, mxcalc=',mxcalc
     995          k1=0
     996          k2=0
     997
     998          if (play(l).le.plev_prof_cas(1)) then
     999
     1000             do k = 1, nlev_cas-1
     1001                if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
     1002                   k1=k
     1003                   k2=k+1
     1004                endif
     1005             enddo
     1006
     1007             if (k1.eq.0 .or. k2.eq.0) then
     1008                write(*,*) 'PB! k1, k2 = ',k1,k2
     1009                write(*,*) 'l,play(l) = ',l,play(l)/100
     1010                do k = 1, nlev_cas-1
     1011                   write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
     1012                enddo
     1013             endif
     1014
     1015
     1016
     1017             frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
     1018
     1019             t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
     1020             theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
     1021             if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
     1022             thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
     1023             thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
     1024             qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))
     1025             ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))
     1026             qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))
     1027             u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
     1028             v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
     1029             ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
     1030             vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
     1031             temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1))
     1032             qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1))
     1033             u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1))
     1034             v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1))
     1035
     1036             invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(k2) &
     1037                  - frac*(invtau_temp_nudg_prof_cas(k2)-invtau_temp_nudg_prof_cas(k1))
     1038             invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(k2) - frac*(invtau_qv_nudg_prof_cas(k2)-invtau_qv_nudg_prof_cas(k1))
     1039             invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(k2) - frac*(invtau_u_nudg_prof_cas(k2)-invtau_u_nudg_prof_cas(k1))
     1040             invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(k2) - frac*(invtau_v_nudg_prof_cas(k2)-invtau_v_nudg_prof_cas(k1))
     1041
     1042             w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
     1043             omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))
     1044             du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
     1045             hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
     1046             vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
     1047             dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
     1048             hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
     1049             vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
     1050             dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
     1051             ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
     1052             vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
     1053             dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))
     1054             hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))
     1055             vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))
     1056             dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
     1057             hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
     1058             vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
     1059             dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))
     1060
     1061          else !play>plev_prof_cas(1)
     1062
     1063             k1=1
     1064             k2=2
     1065             print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)
     1066             frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
     1067             frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
     1068             t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
     1069             theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
     1070             if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
     1071             thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
     1072             thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
     1073             qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2)
     1074             ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2)
     1075             qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2)
     1076             u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
     1077             v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
     1078             ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
     1079             vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
     1080             temp_nudg_mod_cas(l)= frac1*temp_nudg_prof_cas(k1) - frac2*temp_nudg_prof_cas(k2)
     1081             qv_nudg_mod_cas(l)= frac1*qv_nudg_prof_cas(k1) - frac2*qv_nudg_prof_cas(k2)
     1082             u_nudg_mod_cas(l)= frac1*u_nudg_prof_cas(k1) - frac2*u_nudg_prof_cas(k2)
     1083             v_nudg_mod_cas(l)= frac1*v_nudg_prof_cas(k1) - frac2*v_nudg_prof_cas(k2)
     1084
     1085             invtau_temp_nudg_mod_cas(l)= frac1*invtau_temp_nudg_prof_cas(k1) - frac2*invtau_temp_nudg_prof_cas(k2)
     1086             invtau_qv_nudg_mod_cas(l)= frac1*invtau_qv_nudg_prof_cas(k1) - frac2*invtau_qv_nudg_prof_cas(k2)
     1087             invtau_u_nudg_mod_cas(l)= frac1*invtau_u_nudg_prof_cas(k1) - frac2*invtau_u_nudg_prof_cas(k2)
     1088             invtau_v_nudg_mod_cas(l)= frac1*invtau_v_nudg_prof_cas(k1) - frac2*invtau_v_nudg_prof_cas(k2)
     1089
     1090             w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
     1091             omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2)
     1092             du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
     1093             hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
     1094             vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
     1095             dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
     1096             hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
     1097             vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
     1098             dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
     1099             ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
     1100             vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
     1101             dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2)
     1102             hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2)
     1103             vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2)
     1104             dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
     1105             hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
     1106             vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
     1107             dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)
     1108
     1109          endif ! play.le.plev_prof_cas(1)
     1110
     1111       else ! above max altitude of forcing file
     1112
     1113          !jyg
     1114          fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
     1115          fact = max(fact,0.)                                           !jyg
     1116          fact = exp(-fact)                                             !jyg
     1117          t_mod_cas(l)= t_prof_cas(nlev_cas)                            !jyg
     1118          theta_mod_cas(l)= th_prof_cas(nlev_cas)                       !jyg
     1119          thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
     1120          thl_mod_cas(l)= thl_prof_cas(nlev_cas)                        !jyg
     1121          qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact                     !jyg
     1122          ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact                     !jyg
     1123          qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact                     !jyg
     1124          u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                       !jyg
     1125          v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                       !jyg
     1126          ug_mod_cas(l)= ug_prof_cas(nlev_cas)                          !jyg
     1127          vg_mod_cas(l)= vg_prof_cas(nlev_cas)                          !jyg
     1128          temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas)            !jyg
     1129          qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas)                !jyg
     1130          u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas)                  !jyg
     1131          v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas)                  !jyg
     1132
     1133          invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(nlev_cas)            !jyg
     1134          invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(nlev_cas)                !jyg
     1135          invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(nlev_cas)                  !jyg
     1136          invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(nlev_cas)                  !jyg
     1137
     1138          thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
     1139          w_mod_cas(l)= 0.0                                             !jyg
     1140          omega_mod_cas(l)= 0.0                                         !jyg
     1141          du_mod_cas(l)= du_prof_cas(nlev_cas)*fact
     1142          hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                     !jyg
     1143          vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                     !jyg
     1144          dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact
     1145          hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                     !jyg
     1146          vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                     !jyg
     1147          dt_mod_cas(l)= dt_prof_cas(nlev_cas)
     1148          ht_mod_cas(l)= ht_prof_cas(nlev_cas)                          !jyg
     1149          vt_mod_cas(l)= vt_prof_cas(nlev_cas)                          !jyg
     1150          dth_mod_cas(l)= dth_prof_cas(nlev_cas)
     1151          hth_mod_cas(l)= hth_prof_cas(nlev_cas)                        !jyg
     1152          vth_mod_cas(l)= vth_prof_cas(nlev_cas)                        !jyg
     1153          dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact
     1154          hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                     !jyg
     1155          vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                     !jyg
     1156          dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact               !jyg
     1157
     1158       endif ! play
     1159
     1160    enddo ! l
     1161
     1162    ! for variables defined at layer interfaces (EV):
     1163
     1164
     1165    do l = 1, llm+1
     1166
     1167       if (plev(l).ge.plev_prof_cas(nlev_cas)) then
     1168
     1169          mxcalc=l
     1170          k1=0
     1171          k2=0
     1172
     1173          if (plev(l).le.plev_prof_cas(1)) then
     1174
     1175             do k = 1, nlev_cas-1
     1176                if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then
     1177                   k1=k
     1178                   k2=k+1
     1179                endif
     1180             enddo
     1181
     1182             if (k1.eq.0 .or. k2.eq.0) then
     1183                write(*,*) 'PB! k1, k2 = ',k1,k2
     1184                write(*,*) 'l,plev(l) = ',l,plev(l)/100
     1185                do k = 1, nlev_cas-1
     1186                   write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
     1187                enddo
     1188             endif
     1189
     1190             frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
     1191             tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1))
     1192          else !play>plev_prof_cas(1)
     1193             k1=1
     1194             k2=2
     1195             frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
     1196             frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
     1197             tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2)
     1198
     1199          endif ! plev.le.plev_prof_cas(1)
     1200
     1201       else ! above max altitude of forcing file
     1202
     1203          tke_mod_cas(l)=0.0
     1204
     1205       endif ! plev
     1206
     1207    enddo ! l
     1208
     1209
     1210
     1211    return
     1212  end SUBROUTINE interp2_case_vertical_std
     1213  !*****************************************************************************
    12311214
    12321215

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

    r3541 r4482  
    146146!program reading forcings of the TWP-ICE experiment
    147147
    148 !      use netcdf
     148        use netcdf, only: nf90_get_var
    149149
    150150      implicit none
    … …  
    314314       enddo
    315315         
    316 #ifdef NC_DOUBLE
    317          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
    318 #else
    319          ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
    320 #endif
     316         ierr = NF90_GET_VAR(nid,var3didin(1),lat)
    321317         if(ierr/=NF_NOERR) then
    322318            write(*,*) NF_STRERROR(ierr)
    … …  
    325321!         write(*,*)'lecture lat ok',lat
    326322
    327 #ifdef NC_DOUBLE
    328          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
    329 #else
    330          ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
    331 #endif
     323         ierr = NF90_GET_VAR(nid,var3didin(2),lon)
    332324         if(ierr/=NF_NOERR) then
    333325            write(*,*) NF_STRERROR(ierr)
    … …  
    336328!         write(*,*)'lecture lon ok',lon
    337329 
    338 #ifdef NC_DOUBLE
    339          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
    340 #else
    341          ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
    342 #endif
     330         ierr = NF90_GET_VAR(nid,var3didin(3),alt)
    343331         if(ierr/=NF_NOERR) then
    344332            write(*,*) NF_STRERROR(ierr)
    … …  
    347335!          write(*,*)'lecture alt ok',alt
    348336 
    349 #ifdef NC_DOUBLE
    350          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
    351 #else
    352          ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
    353 #endif
     337         ierr = NF90_GET_VAR(nid,var3didin(4),phis)
    354338         if(ierr/=NF_NOERR) then
    355339            write(*,*) NF_STRERROR(ierr)
    … …  
    358342!          write(*,*)'lecture phis ok',phis
    359343         
    360 #ifdef NC_DOUBLE
    361          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
    362 #else
    363          ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
    364 #endif
     344         ierr = NF90_GET_VAR(nid,var3didin(5),T)
    365345         if(ierr/=NF_NOERR) then
    366346            write(*,*) NF_STRERROR(ierr)
    … …  
    369349!         write(*,*)'lecture T ok'
    370350
    371 #ifdef NC_DOUBLE
    372          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
    373 #else
    374          ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
    375 #endif
     351         ierr = NF90_GET_VAR(nid,var3didin(6),q)
    376352         if(ierr/=NF_NOERR) then
    377353            write(*,*) NF_STRERROR(ierr)
    … …  
    385361       enddo
    386362       enddo
    387 #ifdef NC_DOUBLE
    388          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
    389 #else
    390          ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
    391 #endif
     363         ierr = NF90_GET_VAR(nid,var3didin(7),u)
    392364         if(ierr/=NF_NOERR) then
    393365            write(*,*) NF_STRERROR(ierr)
    … …  
    396368!         write(*,*)'lecture u ok'
    397369
    398 #ifdef NC_DOUBLE
    399          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
    400 #else
    401          ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
    402 #endif
     370         ierr = NF90_GET_VAR(nid,var3didin(8),v)
    403371         if(ierr/=NF_NOERR) then
    404372            write(*,*) NF_STRERROR(ierr)
    … …  
    407375!         write(*,*)'lecture v ok'
    408376
    409 #ifdef NC_DOUBLE
    410          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
    411 #else
    412          ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
    413 #endif
     377         ierr = NF90_GET_VAR(nid,var3didin(9),omega)
    414378         if(ierr/=NF_NOERR) then
    415379            write(*,*) NF_STRERROR(ierr)
    … …  
    424388       enddo
    425389
    426 #ifdef NC_DOUBLE
    427          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
    428 #else
    429          ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
    430 #endif
     390         ierr = NF90_GET_VAR(nid,var3didin(10),div)
    431391         if(ierr/=NF_NOERR) then
    432392            write(*,*) NF_STRERROR(ierr)
    … …  
    435395!         write(*,*)'lecture div ok'
    436396
    437 #ifdef NC_DOUBLE
    438          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
    439 #else
    440          ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
    441 #endif
     397         ierr = NF90_GET_VAR(nid,var3didin(11),T_adv_h)
    442398         if(ierr/=NF_NOERR) then
    443399            write(*,*) NF_STRERROR(ierr)
    … …  
    453409
    454410
    455 #ifdef NC_DOUBLE
    456          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
    457 #else
    458          ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
    459 #endif
     411         ierr = NF90_GET_VAR(nid,var3didin(12),T_adv_v)
    460412         if(ierr/=NF_NOERR) then
    461413            write(*,*) NF_STRERROR(ierr)
    … …  
    470422       enddo
    471423
    472 #ifdef NC_DOUBLE
    473          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
    474 #else
    475          ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
    476 #endif
     424         ierr = NF90_GET_VAR(nid,var3didin(13),q_adv_h)
    477425         if(ierr/=NF_NOERR) then
    478426            write(*,*) NF_STRERROR(ierr)
    … …  
    488436
    489437
    490 #ifdef NC_DOUBLE
    491          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
    492 #else
    493          ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
    494 #endif
     438         ierr = NF90_GET_VAR(nid,var3didin(14),q_adv_v)
    495439         if(ierr/=NF_NOERR) then
    496440            write(*,*) NF_STRERROR(ierr)
    … …  
    506450
    507451
    508 #ifdef NC_DOUBLE
    509          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
    510 #else
    511          ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
    512 #endif
    513          if(ierr/=NF_NOERR) then
    514             write(*,*) NF_STRERROR(ierr)
    515             stop "getvarup"
    516          endif
    517 
    518 #ifdef NC_DOUBLE
    519          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
    520 #else
    521          ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
    522 #endif
    523          if(ierr/=NF_NOERR) then
    524             write(*,*) NF_STRERROR(ierr)
    525             stop "getvarup"
    526          endif
    527 
    528 #ifdef NC_DOUBLE
    529          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
    530 #else
    531          ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
    532 #endif
    533          if(ierr/=NF_NOERR) then
    534             write(*,*) NF_STRERROR(ierr)
    535             stop "getvarup"
    536          endif
    537 
    538 #ifdef NC_DOUBLE
    539          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
    540 #else
    541          ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
    542 #endif
    543          if(ierr/=NF_NOERR) then
    544             write(*,*) NF_STRERROR(ierr)
    545             stop "getvarup"
    546          endif
    547 
    548 #ifdef NC_DOUBLE
    549          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
    550 #else
    551          ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
    552 #endif
    553          if(ierr/=NF_NOERR) then
    554             write(*,*) NF_STRERROR(ierr)
    555             stop "getvarup"
    556          endif
    557 
    558 #ifdef NC_DOUBLE
    559          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
    560 #else
    561          ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
    562 #endif
     452         ierr = NF90_GET_VAR(nid,var3didin(15),s)
     453         if(ierr/=NF_NOERR) then
     454            write(*,*) NF_STRERROR(ierr)
     455            stop "getvarup"
     456         endif
     457
     458         ierr = NF90_GET_VAR(nid,var3didin(16),s_adv_h)
     459         if(ierr/=NF_NOERR) then
     460            write(*,*) NF_STRERROR(ierr)
     461            stop "getvarup"
     462         endif
     463
     464         ierr = NF90_GET_VAR(nid,var3didin(17),s_adv_v)
     465         if(ierr/=NF_NOERR) then
     466            write(*,*) NF_STRERROR(ierr)
     467            stop "getvarup"
     468         endif
     469
     470         ierr = NF90_GET_VAR(nid,var3didin(18),p_srf_aver)
     471         if(ierr/=NF_NOERR) then
     472            write(*,*) NF_STRERROR(ierr)
     473            stop "getvarup"
     474         endif
     475
     476         ierr = NF90_GET_VAR(nid,var3didin(19),p_srf_center)
     477         if(ierr/=NF_NOERR) then
     478            write(*,*) NF_STRERROR(ierr)
     479            stop "getvarup"
     480         endif
     481
     482         ierr = NF90_GET_VAR(nid,var3didin(20),T_srf)
    563483         if(ierr/=NF_NOERR) then
    564484            write(*,*) NF_STRERROR(ierr)
    … …  
    572492         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
    573493
    574 !         use netcdf
     494         use netcdf, only: nf90_get_var
    575495
    576496         implicit none
    … …  
    610530         endif
    611531
    612 !#ifdef NC_DOUBLE
    613          ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
    614          ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
    615 !#else
    616 !        ierr = NF_GET_VAR_REAL(nid,timevar,time)
    617 !        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
    618 !#endif
     532         ierr = NF90_GET_VAR(nid,timevar,time)
     533         ierr = NF90_GET_VAR(nid,levvar,lev)
    619534
    620535       return
    … …  
    22552170
    22562171
     2172      use netcdf, only: nf90_get_var
    22572173      implicit none
    22582174
    … …  
    23642280!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    23652281 
    2366 #ifdef NC_DOUBLE
    2367          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
    2368 #else
    2369          ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
    2370 #endif
     2282         ierr = NF90_GET_VAR(nid,var3didin(1),zz)
    23712283         if(ierr/=NF_NOERR) then
    23722284            write(*,*) NF_STRERROR(ierr)
    … …  
    23752287!          write(*,*)'lecture z ok',zz
    23762288
    2377 #ifdef NC_DOUBLE
    2378          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),thl)
    2379 #else
    2380          ierr = NF_GET_VAR_REAL(nid,var3didin(2),thl)
    2381 #endif
     2289         ierr = NF90_GET_VAR(nid,var3didin(2),thl)
    23822290         if(ierr/=NF_NOERR) then
    23832291            write(*,*) NF_STRERROR(ierr)
    … …  
    23862294!          write(*,*)'lecture thl ok',thl
    23872295
    2388 #ifdef NC_DOUBLE
    2389          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qt)
    2390 #else
    2391          ierr = NF_GET_VAR_REAL(nid,var3didin(3),qt)
    2392 #endif
     2296         ierr = NF90_GET_VAR(nid,var3didin(3),qt)
    23932297         if(ierr/=NF_NOERR) then
    23942298            write(*,*) NF_STRERROR(ierr)
    … …  
    23972301!          write(*,*)'lecture qt ok',qt
    23982302 
    2399 #ifdef NC_DOUBLE
    2400          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
    2401 #else
    2402          ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
    2403 #endif
     2303         ierr = NF90_GET_VAR(nid,var3didin(4),u)
    24042304         if(ierr/=NF_NOERR) then
    24052305            write(*,*) NF_STRERROR(ierr)
    … …  
    24082308!          write(*,*)'lecture u ok',u
    24092309
    2410 #ifdef NC_DOUBLE
    2411          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
    2412 #else
    2413          ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
    2414 #endif
     2310         ierr = NF90_GET_VAR(nid,var3didin(5),v)
    24152311         if(ierr/=NF_NOERR) then
    24162312            write(*,*) NF_STRERROR(ierr)
    … …  
    24192315!          write(*,*)'lecture v ok',v
    24202316
    2421 #ifdef NC_DOUBLE
    2422          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tke)
    2423 #else
    2424          ierr = NF_GET_VAR_REAL(nid,var3didin(6),tke)
    2425 #endif
     2317         ierr = NF90_GET_VAR(nid,var3didin(6),tke)
    24262318         if(ierr/=NF_NOERR) then
    24272319            write(*,*) NF_STRERROR(ierr)
    … …  
    24302322!          write(*,*)'lecture tke ok',tke
    24312323
    2432 #ifdef NC_DOUBLE
    2433          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ug)
    2434 #else
    2435          ierr = NF_GET_VAR_REAL(nid,var3didin(7),ug)
    2436 #endif
     2324         ierr = NF90_GET_VAR(nid,var3didin(7),ug)
    24372325         if(ierr/=NF_NOERR) then
    24382326            write(*,*) NF_STRERROR(ierr)
    … …  
    24412329!          write(*,*)'lecture ug ok',ug
    24422330
    2443 #ifdef NC_DOUBLE
    2444          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),vg)
    2445 #else
    2446          ierr = NF_GET_VAR_REAL(nid,var3didin(8),vg)
    2447 #endif
     2331         ierr = NF90_GET_VAR(nid,var3didin(8),vg)
    24482332         if(ierr/=NF_NOERR) then
    24492333            write(*,*) NF_STRERROR(ierr)
    … …  
    24522336!          write(*,*)'lecture vg ok',vg
    24532337
    2454 #ifdef NC_DOUBLE
    2455          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),wls)
    2456 #else
    2457          ierr = NF_GET_VAR_REAL(nid,var3didin(9),wls)
    2458 #endif
     2338         ierr = NF90_GET_VAR(nid,var3didin(9),wls)
    24592339         if(ierr/=NF_NOERR) then
    24602340            write(*,*) NF_STRERROR(ierr)
    … …  
    24632343!          write(*,*)'lecture wls ok',wls
    24642344
    2465 #ifdef NC_DOUBLE
    2466          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),dqtdx)
    2467 #else
    2468          ierr = NF_GET_VAR_REAL(nid,var3didin(10),dqtdx)
    2469 #endif
     2345         ierr = NF90_GET_VAR(nid,var3didin(10),dqtdx)
    24702346         if(ierr/=NF_NOERR) then
    24712347            write(*,*) NF_STRERROR(ierr)
    … …  
    24742350!          write(*,*)'lecture dqtdx ok',dqtdx
    24752351
    2476 #ifdef NC_DOUBLE
    2477          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),dqtdy)
    2478 #else
    2479          ierr = NF_GET_VAR_REAL(nid,var3didin(11),dqtdy)
    2480 #endif
     2352         ierr = NF90_GET_VAR(nid,var3didin(11),dqtdy)
    24812353         if(ierr/=NF_NOERR) then
    24822354            write(*,*) NF_STRERROR(ierr)
    … …  
    24852357!          write(*,*)'lecture dqtdy ok',dqtdy
    24862358
    2487 #ifdef NC_DOUBLE
    2488          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),dqtdt)
    2489 #else
    2490          ierr = NF_GET_VAR_REAL(nid,var3didin(12),dqtdt)
    2491 #endif
     2359         ierr = NF90_GET_VAR(nid,var3didin(12),dqtdt)
    24922360         if(ierr/=NF_NOERR) then
    24932361            write(*,*) NF_STRERROR(ierr)
    … …  
    24962364!          write(*,*)'lecture dqtdt ok',dqtdt
    24972365
    2498 #ifdef NC_DOUBLE
    2499          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),thl_rad)
    2500 #else
    2501          ierr = NF_GET_VAR_REAL(nid,var3didin(13),thl_rad)
    2502 #endif
     2366         ierr = NF90_GET_VAR(nid,var3didin(13),thl_rad)
    25032367         if(ierr/=NF_NOERR) then
    25042368            write(*,*) NF_STRERROR(ierr)
    … …  
    25172381!program reading initial profils and forcings of the Dice case study
    25182382
     2383      use netcdf, only: nf90_get_var
    25192384
    25202385      implicit none
    … …  
    26852550!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    26862551 
    2687 #ifdef NC_DOUBLE
    2688          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
    2689 #else
    2690          ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
    2691 #endif
     2552         ierr = NF90_GET_VAR(nid,var3didin(1),zz)
    26922553         if(ierr/=NF_NOERR) then
    26932554            write(*,*) NF_STRERROR(ierr)
    … …  
    26962557!          write(*,*)'lecture zz ok',zz
    26972558 
    2698 #ifdef NC_DOUBLE
    2699          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pres)
    2700 #else
    2701          ierr = NF_GET_VAR_REAL(nid,var3didin(11),pres)
    2702 #endif
     2559         ierr = NF90_GET_VAR(nid,var3didin(11),pres)
    27032560         if(ierr/=NF_NOERR) then
    27042561            write(*,*) NF_STRERROR(ierr)
    … …  
    27072564!          write(*,*)'lecture pres ok',pres
    27082565
    2709 #ifdef NC_DOUBLE
    2710          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),th)
    2711 #else
    2712          ierr = NF_GET_VAR_REAL(nid,var3didin(12),th)
    2713 #endif
     2566         ierr = NF90_GET_VAR(nid,var3didin(12),th)
    27142567         if(ierr/=NF_NOERR) then
    27152568            write(*,*) NF_STRERROR(ierr)
    … …  
    27212574           enddo
    27222575
    2723 #ifdef NC_DOUBLE
    2724          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),qv)
    2725 #else
    2726          ierr = NF_GET_VAR_REAL(nid,var3didin(13),qv)
    2727 #endif
     2576         ierr = NF90_GET_VAR(nid,var3didin(13),qv)
    27282577         if(ierr/=NF_NOERR) then
    27292578            write(*,*) NF_STRERROR(ierr)
    … …  
    27322581!          write(*,*)'lecture qv ok',qv
    27332582 
    2734 #ifdef NC_DOUBLE
    2735          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),u)
    2736 #else
    2737          ierr = NF_GET_VAR_REAL(nid,var3didin(14),u)
    2738 #endif
     2583         ierr = NF90_GET_VAR(nid,var3didin(14),u)
    27392584         if(ierr/=NF_NOERR) then
    27402585            write(*,*) NF_STRERROR(ierr)
    … …  
    27432588!          write(*,*)'lecture u ok',u
    27442589
    2745 #ifdef NC_DOUBLE
    2746          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),v)
    2747 #else
    2748          ierr = NF_GET_VAR_REAL(nid,var3didin(15),v)
    2749 #endif
     2590         ierr = NF90_GET_VAR(nid,var3didin(15),v)
    27502591         if(ierr/=NF_NOERR) then
    27512592            write(*,*) NF_STRERROR(ierr)
    … …  
    27542595!          write(*,*)'lecture v ok',v
    27552596
    2756 #ifdef NC_DOUBLE
    2757          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),o3)
    2758 #else
    2759          ierr = NF_GET_VAR_REAL(nid,var3didin(16),o3)
    2760 #endif
     2597         ierr = NF90_GET_VAR(nid,var3didin(16),o3)
    27612598         if(ierr/=NF_NOERR) then
    27622599            write(*,*) NF_STRERROR(ierr)
    … …  
    27652602!          write(*,*)'lecture o3 ok',o3
    27662603
    2767 #ifdef NC_DOUBLE
    2768          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),shf)
    2769 #else
    2770          ierr = NF_GET_VAR_REAL(nid,var3didin(2),shf)
    2771 #endif
     2604         ierr = NF90_GET_VAR(nid,var3didin(2),shf)
    27722605         if(ierr/=NF_NOERR) then
    27732606            write(*,*) NF_STRERROR(ierr)
    … …  
    27762609!          write(*,*)'lecture shf ok',shf
    27772610
    2778 #ifdef NC_DOUBLE
    2779          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),lhf)
    2780 #else
    2781          ierr = NF_GET_VAR_REAL(nid,var3didin(3),lhf)
    2782 #endif
     2611         ierr = NF90_GET_VAR(nid,var3didin(3),lhf)
    27832612         if(ierr/=NF_NOERR) then
    27842613            write(*,*) NF_STRERROR(ierr)
    … …  
    27872616!          write(*,*)'lecture lhf ok',lhf
    27882617
    2789 #ifdef NC_DOUBLE
    2790          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),lwup)
    2791 #else
    2792          ierr = NF_GET_VAR_REAL(nid,var3didin(4),lwup)
    2793 #endif
     2618         ierr = NF90_GET_VAR(nid,var3didin(4),lwup)
    27942619         if(ierr/=NF_NOERR) then
    27952620            write(*,*) NF_STRERROR(ierr)
    … …  
    27982623!          write(*,*)'lecture lwup ok',lwup
    27992624
    2800 #ifdef NC_DOUBLE
    2801          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),swup)
    2802 #else
    2803          ierr = NF_GET_VAR_REAL(nid,var3didin(5),swup)
    2804 #endif
     2625         ierr = NF90_GET_VAR(nid,var3didin(5),swup)
    28052626         if(ierr/=NF_NOERR) then
    28062627            write(*,*) NF_STRERROR(ierr)
    … …  
    28092630!          write(*,*)'lecture swup ok',swup
    28102631
    2811 #ifdef NC_DOUBLE
    2812          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tg)
    2813 #else
    2814          ierr = NF_GET_VAR_REAL(nid,var3didin(6),tg)
    2815 #endif
     2632         ierr = NF90_GET_VAR(nid,var3didin(6),tg)
    28162633         if(ierr/=NF_NOERR) then
    28172634            write(*,*) NF_STRERROR(ierr)
    … …  
    28202637!          write(*,*)'lecture tg ok',tg
    28212638
    2822 #ifdef NC_DOUBLE
    2823          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ustar)
    2824 #else
    2825          ierr = NF_GET_VAR_REAL(nid,var3didin(7),ustar)
    2826 #endif
     2639         ierr = NF90_GET_VAR(nid,var3didin(7),ustar)
    28272640         if(ierr/=NF_NOERR) then
    28282641            write(*,*) NF_STRERROR(ierr)
    … …  
    28312644!          write(*,*)'lecture ustar ok',ustar
    28322645
    2833 #ifdef NC_DOUBLE
    2834          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),psurf)
    2835 #else
    2836          ierr = NF_GET_VAR_REAL(nid,var3didin(8),psurf)
    2837 #endif
     2646         ierr = NF90_GET_VAR(nid,var3didin(8),psurf)
    28382647         if(ierr/=NF_NOERR) then
    28392648            write(*,*) NF_STRERROR(ierr)
    … …  
    28422651!          write(*,*)'lecture psurf ok',psurf
    28432652
    2844 #ifdef NC_DOUBLE
    2845          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),ug)
    2846 #else
    2847          ierr = NF_GET_VAR_REAL(nid,var3didin(9),ug)
    2848 #endif
     2653         ierr = NF90_GET_VAR(nid,var3didin(9),ug)
    28492654         if(ierr/=NF_NOERR) then
    28502655            write(*,*) NF_STRERROR(ierr)
    … …  
    28532658!          write(*,*)'lecture ug ok',ug
    28542659
    2855 #ifdef NC_DOUBLE
    2856          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),vg)
    2857 #else
    2858          ierr = NF_GET_VAR_REAL(nid,var3didin(10),vg)
    2859 #endif
     2660         ierr = NF90_GET_VAR(nid,var3didin(10),vg)
    28602661         if(ierr/=NF_NOERR) then
    28612662            write(*,*) NF_STRERROR(ierr)
    … …  
    28642665!          write(*,*)'lecture vg ok',vg
    28652666
    2866 #ifdef NC_DOUBLE
    2867          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hadvt)
    2868 #else
    2869          ierr = NF_GET_VAR_REAL(nid,var3didin(17),hadvt)
    2870 #endif
     2667         ierr = NF90_GET_VAR(nid,var3didin(17),hadvt)
    28712668         if(ierr/=NF_NOERR) then
    28722669            write(*,*) NF_STRERROR(ierr)
    … …  
    28752672!          write(*,*)'lecture hadvt ok',hadvt
    28762673
    2877 #ifdef NC_DOUBLE
    2878          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),hadvq)
    2879 #else
    2880          ierr = NF_GET_VAR_REAL(nid,var3didin(18),hadvq)
    2881 #endif
     2674         ierr = NF90_GET_VAR(nid,var3didin(18),hadvq)
    28822675         if(ierr/=NF_NOERR) then
    28832676            write(*,*) NF_STRERROR(ierr)
    … …  
    28862679!          write(*,*)'lecture hadvq ok',hadvq
    28872680
    2888 #ifdef NC_DOUBLE
    2889          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),hadvu)
    2890 #else
    2891          ierr = NF_GET_VAR_REAL(nid,var3didin(19),hadvu)
    2892 #endif
     2681         ierr = NF90_GET_VAR(nid,var3didin(19),hadvu)
    28932682         if(ierr/=NF_NOERR) then
    28942683            write(*,*) NF_STRERROR(ierr)
    … …  
    28972686!          write(*,*)'lecture hadvu ok',hadvu
    28982687
    2899 #ifdef NC_DOUBLE
    2900          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),hadvv)
    2901 #else
    2902          ierr = NF_GET_VAR_REAL(nid,var3didin(20),hadvv)
    2903 #endif
     2688         ierr = NF90_GET_VAR(nid,var3didin(20),hadvv)
    29042689         if(ierr/=NF_NOERR) then
    29052690            write(*,*) NF_STRERROR(ierr)
    … …  
    29082693!          write(*,*)'lecture hadvv ok',hadvv
    29092694
    2910 #ifdef NC_DOUBLE
    2911          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),w)
    2912 #else
    2913          ierr = NF_GET_VAR_REAL(nid,var3didin(21),w)
    2914 #endif
     2695         ierr = NF90_GET_VAR(nid,var3didin(21),w)
    29152696         if(ierr/=NF_NOERR) then
    29162697            write(*,*) NF_STRERROR(ierr)
    … …  
    29192700!          write(*,*)'lecture w ok',w
    29202701
    2921 #ifdef NC_DOUBLE
    2922          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),omega)
    2923 #else
    2924          ierr = NF_GET_VAR_REAL(nid,var3didin(22),omega)
    2925 #endif
     2702         ierr = NF90_GET_VAR(nid,var3didin(22),omega)
    29262703         if(ierr/=NF_NOERR) then
    29272704            write(*,*) NF_STRERROR(ierr)
    … …  
    29382715!program reading initial profils and forcings of the Gabls4 case study
    29392716
     2717      use netcdf, only: nf90_get_var
    29402718
    29412719      implicit none
    … …  
    30682846!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    30692847 
    3070 #ifdef NC_DOUBLE
    3071          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz_i)
    3072 #else
    3073          ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz_i)
    3074 #endif
    3075          if(ierr/=NF_NOERR) then
    3076             write(*,*) NF_STRERROR(ierr)
    3077             stop "getvarup"
    3078          endif
    3079  
    3080 #ifdef NC_DOUBLE
    3081          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),depth_sn)
    3082 #else
    3083          ierr = NF_GET_VAR_REAL(nid,var3didin(2),depth_sn)
    3084 #endif
    3085          if(ierr/=NF_NOERR) then
    3086             write(*,*) NF_STRERROR(ierr)
    3087             stop "getvarup"
    3088          endif
    3089  
    3090 #ifdef NC_DOUBLE
    3091          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),ug_i)
    3092 #else
    3093          ierr = NF_GET_VAR_REAL(nid,var3didin(3),ug_i)
    3094 #endif
    3095          if(ierr/=NF_NOERR) then
    3096             write(*,*) NF_STRERROR(ierr)
    3097             stop "getvarup"
    3098          endif
    3099  
    3100 #ifdef NC_DOUBLE
    3101          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),vg_i)
    3102 #else
    3103          ierr = NF_GET_VAR_REAL(nid,var3didin(4),vg_i)
    3104 #endif
    3105          if(ierr/=NF_NOERR) then
    3106             write(*,*) NF_STRERROR(ierr)
    3107             stop "getvarup"
    3108          endif
    3109  
    3110 #ifdef NC_DOUBLE
    3111          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),pf_i)
    3112 #else
    3113          ierr = NF_GET_VAR_REAL(nid,var3didin(5),pf_i)
    3114 #endif
    3115          if(ierr/=NF_NOERR) then
    3116             write(*,*) NF_STRERROR(ierr)
    3117             stop "getvarup"
    3118          endif
    3119 
    3120 #ifdef NC_DOUBLE
    3121          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),th_i)
    3122 #else
    3123          ierr = NF_GET_VAR_REAL(nid,var3didin(6),th_i)
    3124 #endif
    3125          if(ierr/=NF_NOERR) then
    3126             write(*,*) NF_STRERROR(ierr)
    3127             stop "getvarup"
    3128          endif
    3129 
    3130 #ifdef NC_DOUBLE
    3131          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),t_i)
    3132 #else
    3133          ierr = NF_GET_VAR_REAL(nid,var3didin(7),t_i)
    3134 #endif
    3135          if(ierr/=NF_NOERR) then
    3136             write(*,*) NF_STRERROR(ierr)
    3137             stop "getvarup"
    3138          endif
    3139 
    3140 #ifdef NC_DOUBLE
    3141          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),qv_i)
    3142 #else
    3143          ierr = NF_GET_VAR_REAL(nid,var3didin(8),qv_i)
    3144 #endif
    3145          if(ierr/=NF_NOERR) then
    3146             write(*,*) NF_STRERROR(ierr)
    3147             stop "getvarup"
    3148          endif
    3149  
    3150 #ifdef NC_DOUBLE
    3151          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),u_i)
    3152 #else
    3153          ierr = NF_GET_VAR_REAL(nid,var3didin(9),u_i)
    3154 #endif
    3155          if(ierr/=NF_NOERR) then
    3156             write(*,*) NF_STRERROR(ierr)
    3157             stop "getvarup"
    3158          endif
    3159  
    3160 #ifdef NC_DOUBLE
    3161          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),v_i)
    3162 #else
    3163          ierr = NF_GET_VAR_REAL(nid,var3didin(10),v_i)
    3164 #endif
    3165          if(ierr/=NF_NOERR) then
    3166             write(*,*) NF_STRERROR(ierr)
    3167             stop "getvarup"
    3168          endif
    3169  
    3170 #ifdef NC_DOUBLE
    3171          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),hadvt_i)
    3172 #else
    3173          ierr = NF_GET_VAR_REAL(nid,var3didin(11),hadvt_i)
    3174 #endif
    3175          if(ierr/=NF_NOERR) then
    3176             write(*,*) NF_STRERROR(ierr)
    3177             stop "getvarup"
    3178          endif
    3179  
    3180 #ifdef NC_DOUBLE
    3181          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),hadvq_i)
    3182 #else
    3183          ierr = NF_GET_VAR_REAL(nid,var3didin(12),hadvq_i)
    3184 #endif
    3185          if(ierr/=NF_NOERR) then
    3186             write(*,*) NF_STRERROR(ierr)
    3187             stop "getvarup"
    3188          endif
    3189  
    3190 #ifdef NC_DOUBLE
    3191          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),tsnow)
    3192 #else
    3193          ierr = NF_GET_VAR_REAL(nid,var3didin(14),tsnow)
    3194 #endif
    3195          if(ierr/=NF_NOERR) then
    3196             write(*,*) NF_STRERROR(ierr)
    3197             stop "getvarup"
    3198          endif
    3199  
    3200 #ifdef NC_DOUBLE
    3201          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),snow_dens)
    3202 #else
    3203          ierr = NF_GET_VAR_REAL(nid,var3didin(15),snow_dens)
    3204 #endif
    3205          if(ierr/=NF_NOERR) then
    3206             write(*,*) NF_STRERROR(ierr)
    3207             stop "getvarup"
    3208          endif
    3209 
    3210 #ifdef NC_DOUBLE
    3211          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),tg)
    3212 #else
    3213          ierr = NF_GET_VAR_REAL(nid,var3didin(16),tg)
    3214 #endif
     2848         ierr = NF90_GET_VAR(nid,var3didin(1),zz_i)
     2849         if(ierr/=NF_NOERR) then
     2850            write(*,*) NF_STRERROR(ierr)
     2851            stop "getvarup"
     2852         endif
     2853 
     2854         ierr = NF90_GET_VAR(nid,var3didin(2),depth_sn)
     2855         if(ierr/=NF_NOERR) then
     2856            write(*,*) NF_STRERROR(ierr)
     2857            stop "getvarup"
     2858         endif
     2859 
     2860         ierr = NF90_GET_VAR(nid,var3didin(3),ug_i)
     2861         if(ierr/=NF_NOERR) then
     2862            write(*,*) NF_STRERROR(ierr)
     2863            stop "getvarup"
     2864         endif
     2865 
     2866         ierr = NF90_GET_VAR(nid,var3didin(4),vg_i)
     2867         if(ierr/=NF_NOERR) then
     2868            write(*,*) NF_STRERROR(ierr)
     2869            stop "getvarup"
     2870         endif
     2871 
     2872         ierr = NF90_GET_VAR(nid,var3didin(5),pf_i)
     2873         if(ierr/=NF_NOERR) then
     2874            write(*,*) NF_STRERROR(ierr)
     2875            stop "getvarup"
     2876         endif
     2877
     2878         ierr = NF90_GET_VAR(nid,var3didin(6),th_i)
     2879         if(ierr/=NF_NOERR) then
     2880            write(*,*) NF_STRERROR(ierr)
     2881            stop "getvarup"
     2882         endif
     2883
     2884         ierr = NF90_GET_VAR(nid,var3didin(7),t_i)
     2885         if(ierr/=NF_NOERR) then
     2886            write(*,*) NF_STRERROR(ierr)
     2887            stop "getvarup"
     2888         endif
     2889
     2890         ierr = NF90_GET_VAR(nid,var3didin(8),qv_i)
     2891         if(ierr/=NF_NOERR) then
     2892            write(*,*) NF_STRERROR(ierr)
     2893            stop "getvarup"
     2894         endif
     2895 
     2896         ierr = NF90_GET_VAR(nid,var3didin(9),u_i)
     2897         if(ierr/=NF_NOERR) then
     2898            write(*,*) NF_STRERROR(ierr)
     2899            stop "getvarup"
     2900         endif
     2901 
     2902         ierr = NF90_GET_VAR(nid,var3didin(10),v_i)
     2903         if(ierr/=NF_NOERR) then
     2904            write(*,*) NF_STRERROR(ierr)
     2905            stop "getvarup"
     2906         endif
     2907 
     2908         ierr = NF90_GET_VAR(nid,var3didin(11),hadvt_i)
     2909         if(ierr/=NF_NOERR) then
     2910            write(*,*) NF_STRERROR(ierr)
     2911            stop "getvarup"
     2912         endif
     2913 
     2914         ierr = NF90_GET_VAR(nid,var3didin(12),hadvq_i)
     2915         if(ierr/=NF_NOERR) then
     2916            write(*,*) NF_STRERROR(ierr)
     2917            stop "getvarup"
     2918         endif
     2919 
     2920         ierr = NF90_GET_VAR(nid,var3didin(14),tsnow)
     2921         if(ierr/=NF_NOERR) then
     2922            write(*,*) NF_STRERROR(ierr)
     2923            stop "getvarup"
     2924         endif
     2925 
     2926         ierr = NF90_GET_VAR(nid,var3didin(15),snow_dens)
     2927         if(ierr/=NF_NOERR) then
     2928            write(*,*) NF_STRERROR(ierr)
     2929            stop "getvarup"
     2930         endif
     2931
     2932         ierr = NF90_GET_VAR(nid,var3didin(16),tg)
    32152933         if(ierr/=NF_NOERR) then
    32162934            write(*,*) NF_STRERROR(ierr)

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

    r3780 r4482  
    843843      if (forcing_case) then
    844844
    845          write(*,*),'avant call read_1D_cas'
     845         write(*,*) 'avant call read_1D_cas'
    846846         call read_1D_cas
    847847         write(*,*) 'Forcing read'
    … …  
    918918      if (forcing_case2) then
    919919
    920          write(*,*),'avant call read2_1D_cas'
     920         write(*,*) 'avant call read2_1D_cas'
    921921         call read2_1D_cas
    922922         write(*,*) 'Forcing read'
    … …  
    10171017      if (forcing_SCM) then
    10181018
    1019          write(*,*),'avant call old_read_SCM_cas'
     1019         write(*,*) 'avant call old_read_SCM_cas'
    10201020         call old_read_SCM_cas
    10211021         write(*,*) 'Forcing read'

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/old_lmdz1d.F90

    r4110 r4482  
    494494!      calend = 'earth_365d'
    495495      if (calend == 'earth_360d') then
    496         call ioconf_calendar('360d')
     496        call ioconf_calendar('360_day')
    497497        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
    498498      else if (calend == 'earth_365d') then
    … …  
    613613      call init_dimphy1D(1,llm)
    614614      call suphel
    615       call infotrac_init
     615      call init_infotrac
    616616
    617617      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/replay1d.F90

    r4113 r4482  
    11PROGRAM rejouer
    22
    3   USE mod_const_mpi, ONLY: comm_lmdz
    4   USE inigeomphy_mod, ONLY: inigeomphy
    5  USE comvert_mod, ONLY: presnivs
     3USE mod_const_mpi, ONLY: comm_lmdz
     4USE inigeomphy_mod, ONLY: inigeomphy
     5USE comvert_mod, ONLY: presnivs
    66USE comvert_mod, only :  preff, pa
     7USE ioipsl, only: getin
     8
    79
    810
    … …  
    1719
    1820integer ntime
    19 integer jour0,mois0,an0
    20 integer it
     21integer jour0,mois0,an0,day_step,anneeref,dayref
    2122integer klev,klon
     23CHARACTER (len=10) :: calend
     24CHARACTER(len=20) :: calendrier
     25
    2226
    2327!---------------------------------------------------------------------
    … …  
    3135
    3236preff=101325.
     37!preff=100000.
    3338pa=50000.
    34 open(82,file='dump_param.bin',form='unformatted',status='old')
    3539  CALL disvert()
    3640  CALL inigeomphy(1,1,llm, &
    … …  
    4347
    4448CALL suphel
    45 ntime=100
    46 jour0=1
    47 mois0=1
    48 an0=2000
     49!ntime=4320
     50ntime=10000000
     51dayref=1
     52anneeref=2000
     53call getin('dayref',dayref)
     54call getin('anneeref',anneeref)
     55call getin('calend',calend)
     56call getin('day_step',day_step)
     57calendrier=calend
     58if ( calendrier == "earth_360d" ) calendrier="360_day"
     59
     60
     61jour0=dayref
     62mois0=(jour0-1)/30+1
     63jour0=jour0-30*((jour0-1)/30)
     64an0=anneeref
     65
     66!print*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0
     67
     68
    4969klon=1
    5070klev=llm
    51 call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,900.,'360d')
     71call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier)
     72! Consistent with ... CALL iophys_ini(600.)
    5273
    5374!---------------------------------------------------------------------
    5475! Initialisation de la parametrisation
    5576!---------------------------------------------------------------------
    56       call get_ini_module
     77call get_ini_module
    5778
    5879!---------------------------------------------------------------------
    5980! Boucle en temps sur l'appel à la parametrisation
    6081!---------------------------------------------------------------------
    61       DO it=1,ntime
    62          print*,'Pas de temps ',it,klon,klev
    63          call call_param_replay(klon,klev)
    64       ENDDO
    65       END
     82call call_param_replay(klon,klev)
    6683
     84end
    6785
    6886!---------------------------------------------------------------------

  • LMDZ6/branches/LMDZ_ECRad/libf/phylmd/dyn1d/scm.F90

    r4104 r4482  
    327327!      calend = 'earth_365d'
    328328      if (calend == 'earth_360d') then
    329         call ioconf_calendar('360d')
     329        call ioconf_calendar('360_day')
    330330        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
    331331      else if (calend == 'earth_365d') then
    … …  
    393393      call init_dimphy1D(1,llm)
    394394      call suphel
    395       call infotrac_init
     395      call init_infotrac
    396396
    397397      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
    … …  
    496496        stop 'in initialization'
    497497      endif ! forcing_GCM2SCM
    498 
    499       print*,'mxcalc=',mxcalc
    500 !     print*,'zlay=',zlay(mxcalc)
    501 !      print*,'play=',play(mxcalc)
    502 
    503 !! When surface temperature is forced
    504       tg= tsurf ! surface T used in read_tsurf1d
    505498
    506499
Note: See TracChangeset for help on using the changeset viewer.