Ignore:
Timestamp:
Dec 6, 2022, 12:01:16 AM (2 years ago)
Author:
lguez
Message:

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
12 edited
1 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

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

    r3798 r4368  
    713713!!      enddo
    714714      DO iq = 1,nqtot
    715         nmq(iq) = trim(tname(iq))
     715        nmq(iq) = trim(tracers(iq)%name)
    716716      ENDDO
    717717      print*,'in dyn1deta0 ',fichnom,klon,klev,nqtot
    … …  
    864864!!      nmq(4)="tra2"
    865865      DO iq = 1,nqtot
    866         nmq(iq) = trim(tname(iq))
     866        nmq(iq) = trim(tracers(iq)%name)
    867867      ENDDO
    868868
    … …  
    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/Ocean_skin/libf/phylmd/dyn1d/1D_decl_cases.h

    r3798 r4368  
    3434        real w_mod(llm), t_mod(llm),q_mod(llm)
    3535        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
    36             real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)
     36            real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)       
    3737        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
    3838        real th_mod(llm)
    … …  
    286286        real ug_mod_cas(llm),vg_mod_cas(llm)
    287287        real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm),v_nudg_mod_cas(llm),u_nudg_mod_cas(llm)
     288        real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm),invtau_u_nudg_mod_cas(llm)
    288289        real u_mod_cas(llm),v_mod_cas(llm)
    289290        real omega_mod_cas(llm),tke_mod_cas(llm+1)

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

    r3798 r4368  
    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                               &
     15     &       ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
    1516     &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                                       &
    1617     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
    … …  
    1819     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    1920!
    20      &       ,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  &
    2122     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    2223     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
    2324     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
     25     &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas  &     
    2426     &       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                     &
    2527     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
    … …  
    2931     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
    3032! EV tg instead of ts_cur
    31              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
    3238!            psurf=plev_prof_cas(1)
    3339             psurf=ps_prof_cas
    … …  
    3945     &         ,ug_prof_cas,vg_prof_cas                                                                   &
    4046     &         ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                       &
     47     &         ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
     48
    4149     &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
    4250     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
    … …  
    4755     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
    4856     &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
     57     &         ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas   &     
    4958     &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
    5059     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &

  • LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/1D_nudge_sandu_astex.h

    r3605 r4368  
    3333
    3434
    35         print*,'OLDLMDZ1D IOPH'
    36       CALL iophys_ecrit('relax_thl',klev,'relax_thl','m/s',relax_thl)
    37       CALL iophys_ecrit('d_t_adv',klev,'d_t_adv','m/s',d_t_adv)
    38       CALL iophys_ecrit('temp',klev,'temp','m/s',temp)
    39       CALL iophys_ecrit('q',klev,'q','m/s',q(:,1))
    40       CALL iophys_ecrit('relax_q',klev,'relax_q','m/s',relax_q(:,1))
    41       CALL iophys_ecrit('d_q_adv',klev,'d_q_adv','m/s',d_q_adv(:,1))
     35      ! print*,'OLDLMDZ1D IOPH'
     36      !      CALL iophys_ecrit('relax_thl',klev,'relax_thl','m/s',relax_thl)
     37      !      CALL iophys_ecrit('d_t_adv',klev,'d_t_adv','m/s',d_t_adv)
     38      !      CALL iophys_ecrit('temp',klev,'temp','m/s',temp)
     39      !      CALL iophys_ecrit('q',klev,'q','m/s',q(:,1))
     40      !      CALL iophys_ecrit('relax_q',klev,'relax_q','m/s',relax_q(:,1))
     41      !      CALL iophys_ecrit('d_q_adv',klev,'d_q_adv','m/s',d_q_adv(:,1))
    4242

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

    r3798 r4368  
    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                               &
    29      &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                                       &
     29     &       ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas    &
     30     &       ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas                               &
    3031     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
    3132     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
    3233     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas                                           &
    3334!
    34      &       ,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  &
    3536     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
    3637     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                                 &
    3738     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas           &
     39     &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas &
    3840     &       ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                    &
    3941     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
    … …  
    5456     &         ,ug_prof_cas,vg_prof_cas                                                                   &
    5557     &       ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas                         &
    56 
     58     &       ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas       &
    5759     &         ,vitw_prof_cas,omega_prof_cas,tke_prof_cas                                                 &
    5860     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
    … …  
    6365     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas                                                 &
    6466     &         ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas                           &
     67     &         ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas        &
    6568     &         ,w_mod_cas,omega_mod_cas,tke_mod_cas                                                       &
    6669     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
    … …  
    7073
    7174! initial and boundary conditions :
    72 !     tsurf = ts_prof_cas
    7375      psurf = ps_prof_cas
    74       !EV tg instead of ts_cur
    75       tg = ts_prof_cas
    76       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
    7786
    7887      do l = 1, llm
    … …  
    8089       q(l,1) = qv_mod_cas(l)
    8190       q(l,2) = ql_mod_cas(l)
     91       q(l,3) = qi_mod_cas(l)
    8292       u(l) = u_mod_cas(l)
    8393       ug(l)= ug_mod_cas(l)

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

    r3798 r4368  
    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       print*,'ON EST VRAIMENT LA'
    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 #ifdef NC_DOUBLE
    380          ierr = NF_GET_VAR_DOUBLE(nid,timeid,time_val)
    381 #else
    382            ierr = NF_GET_VAR_REAL(nid,timeid,time_val)
    383 #endif
    384            if(ierr/=NF_NOERR) then
    385               print *,'Pb a la lecture de time cas.nc: '
    386            endif
    387    endif
    388    IF (nt_cas>1) THEN
    389            pdt_cas=time_val(2)-time_val(1)
    390    ELSE
    391            pdt_cas=0.
    392    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
    393389
    394390
    395391!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    396 !profils moyens:
    397         allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))       
    398         allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
    399         allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1))
    400         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), &
    401              qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    402         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))
    403         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))
    404 
    405 !forcing
    406         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))
    407         allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
    408         allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
    409         allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
    410         allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
    411         allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
    412         allocate(ug_cas(nlev_cas,nt_cas))
    413         allocate(vg_cas(nlev_cas,nt_cas))
    414         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))
    415         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))
    416 
    417 
    418 
    419 !champs interpoles
    420         allocate(plev_prof_cas(nlev_cas))
    421         allocate(t_prof_cas(nlev_cas))
    422         allocate(theta_prof_cas(nlev_cas))
    423         allocate(thl_prof_cas(nlev_cas))
    424         allocate(thv_prof_cas(nlev_cas))
    425         allocate(q_prof_cas(nlev_cas))
    426         allocate(qv_prof_cas(nlev_cas))
    427         allocate(ql_prof_cas(nlev_cas))
    428         allocate(qi_prof_cas(nlev_cas))
    429         allocate(rh_prof_cas(nlev_cas))
    430         allocate(rv_prof_cas(nlev_cas))
    431         allocate(u_prof_cas(nlev_cas))
    432         allocate(v_prof_cas(nlev_cas))
    433         allocate(vitw_prof_cas(nlev_cas))
    434         allocate(omega_prof_cas(nlev_cas))
    435         allocate(ug_prof_cas(nlev_cas))
    436         allocate(vg_prof_cas(nlev_cas))
    437         allocate(ht_prof_cas(nlev_cas))
    438         allocate(hth_prof_cas(nlev_cas))
    439         allocate(hq_prof_cas(nlev_cas))
    440         allocate(hu_prof_cas(nlev_cas))
    441         allocate(hv_prof_cas(nlev_cas))
    442         allocate(vt_prof_cas(nlev_cas))
    443         allocate(vth_prof_cas(nlev_cas))
    444         allocate(vq_prof_cas(nlev_cas))
    445         allocate(vu_prof_cas(nlev_cas))
    446         allocate(vv_prof_cas(nlev_cas))
    447         allocate(dt_prof_cas(nlev_cas))
    448         allocate(dth_prof_cas(nlev_cas))
    449         allocate(dtrad_prof_cas(nlev_cas))
    450         allocate(dq_prof_cas(nlev_cas))
    451         allocate(du_prof_cas(nlev_cas))
    452         allocate(dv_prof_cas(nlev_cas))
    453         allocate(uw_prof_cas(nlev_cas))
    454         allocate(vw_prof_cas(nlev_cas))
    455         allocate(q1_prof_cas(nlev_cas))
    456         allocate(q2_prof_cas(nlev_cas))
    457 
    458         print*,'Allocations OK'
    459         call old_read_SCM (nid,nlev_cas,nt_cas,                                                                     &
    460      &     ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
    461      &     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,        &
    462      &     dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
    463      &     dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
    464      &     uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
    465      &     o3_cas,rugos_cas,clay_cas,sand_cas)
    466         print*,'Read2 cas OK'
    467         do ii=1,nlev_cas
    468         print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
    469         enddo
    470 
    471 
    472 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
    473469
    474470
    475471!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    476 SUBROUTINE deallocate2_1D_cases
    477 !profils environnementaux:
    478         deallocate(plev_cas,plevh_cas)
    479        
    480         deallocate(z_cas,zh_cas)
    481         deallocate(ap_cas,bp_cas)
    482         deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
    483         deallocate(th_cas,thl_cas,thv_cas,rv_cas)
    484         deallocate(u_cas,v_cas,vitw_cas,omega_cas)
    485        
    486 !forcing
    487         deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    488         deallocate(hq_cas,vq_cas,dq_cas)
    489         deallocate(hth_cas,vth_cas,dth_cas)
    490         deallocate(hr_cas,vr_cas,dr_cas)
    491         deallocate(hu_cas,vu_cas,du_cas)
    492         deallocate(hv_cas,vv_cas,dv_cas)
    493         deallocate(ug_cas)
    494         deallocate(vg_cas)
    495         deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
    496 
    497 !champs interpoles
    498         deallocate(plev_prof_cas)
    499         deallocate(t_prof_cas)
    500         deallocate(theta_prof_cas)
    501         deallocate(thl_prof_cas)
    502         deallocate(thv_prof_cas)
    503         deallocate(q_prof_cas)
    504         deallocate(qv_prof_cas)
    505         deallocate(ql_prof_cas)
    506         deallocate(qi_prof_cas)
    507         deallocate(rh_prof_cas)
    508         deallocate(rv_prof_cas)
    509         deallocate(u_prof_cas)
    510         deallocate(v_prof_cas)
    511         deallocate(vitw_prof_cas)
    512         deallocate(omega_prof_cas)
    513         deallocate(ug_prof_cas)
    514         deallocate(vg_prof_cas)
    515         deallocate(ht_prof_cas)
    516         deallocate(hq_prof_cas)
    517         deallocate(hu_prof_cas)
    518         deallocate(hv_prof_cas)
    519         deallocate(vt_prof_cas)
    520         deallocate(vq_prof_cas)
    521         deallocate(vu_prof_cas)
    522         deallocate(vv_prof_cas)
    523         deallocate(dt_prof_cas)
    524         deallocate(dtrad_prof_cas)
    525         deallocate(dq_prof_cas)
    526         deallocate(du_prof_cas)
    527         deallocate(dv_prof_cas)
    528         deallocate(t_prof_cas)
    529         deallocate(u_prof_cas)
    530         deallocate(v_prof_cas)
    531         deallocate(uw_prof_cas)
    532         deallocate(vw_prof_cas)
    533         deallocate(q1_prof_cas)
    534         deallocate(q2_prof_cas)
    535 
    536 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
    537533
    538534
    539535END MODULE mod_1D_cases_read2
    540536!=====================================================================
    541       subroutine read_cas2(nid,nlevel,ntime                          &
    542      &     ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
    543      &     du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
    544      &     dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
    545 
    546 !program reading forcing of the case study
    547       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
    548545#include "netcdf.inc"
    549546
    550       integer ntime,nlevel
    551 
    552       real zz(nlevel,ntime)
    553       real pp(nlevel,ntime)
    554       real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
    555       real theta(nlevel,ntime),rv(nlevel,ntime)
    556       real u(nlevel,ntime)
    557       real v(nlevel,ntime)
    558       real ug(nlevel,ntime)
    559       real vg(nlevel,ntime)
    560       real w(nlevel,ntime)
    561       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    562       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    563       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    564       real dtrad(nlevel,ntime)
    565       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    566       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
    567       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    568       real flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
    569       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
    570 
    571 
    572       integer nid, ierr, ierr1,ierr2,rid,i
    573       integer nbvar3d
    574       parameter(nbvar3d=39)
    575       integer var3didin(nbvar3d)
    576       character*5 name_var(1:nbvar3d)
    577       data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
    578      &'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
    579      &'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/
    580 
    581        do i=1,nbvar3d
    582          print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
    583        enddo
    584        do i=1,nbvar3d
    585          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    586          print *,'ierr=',i,ierr,name_var(i),var3didin(i)
    587          if(ierr/=NF_NOERR) then
    588            print *,'Variable manquante dans cas.nc:',name_var(i)
    589          endif
    590        enddo
    591        do i=1,nbvar3d
    592          print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
    593          if(i.LE.35) then
    594 #ifdef NC_DOUBLE
    595          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    596 #else
    597          ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    598 #endif
    599          print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    600          if(ierr/=NF_NOERR) then
    601             print *,'Pb a la lecture de cas.nc: ',name_var(i)
    602             stop "getvarup"
    603          endif
    604          else
    605 #ifdef NC_DOUBLE
    606          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)
    607 #else
    608          ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)
    609 #endif
    610          print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    611          if(ierr/=NF_NOERR) then
    612             print *,'Pb a la lecture de cas.nc: ',name_var(i)
    613             stop "getvarup"
    614          endif
    615          endif
    616          select case(i)
    617            case(1) ; zz=resul
    618            case(2) ; pp=resul
    619            case(3) ; temp=resul
    620            case(4) ; qv=resul
    621            case(5) ; rh=resul
    622            case(6) ; theta=resul
    623            case(7) ; rv=resul
    624            case(8) ; u=resul
    625            case(9) ; v=resul
    626            case(10) ; ug=resul
    627            case(11) ; vg=resul
    628            case(12) ; w=resul
    629            case(13) ; du=resul
    630            case(14) ; hu=resul
    631            case(15) ; vu=resul
    632            case(16) ; dv=resul
    633            case(17) ; hv=resul
    634            case(18) ; vv=resul
    635            case(19) ; dt=resul
    636            case(20) ; ht=resul
    637            case(21) ; vt=resul
    638            case(22) ; dq=resul
    639            case(23) ; hq=resul
    640            case(24) ; vq=resul
    641            case(25) ; dth=resul
    642            case(26) ; hth=resul
    643            case(27) ; vth=resul
    644            case(28) ; dr=resul
    645            case(29) ; hr=resul
    646            case(30) ; vr=resul
    647            case(31) ; dtrad=resul
    648            case(32) ; uw=resul
    649            case(33) ; vw=resul
    650            case(34) ; q1=resul
    651            case(35) ; q2=resul
    652            case(36) ; sens=resul1
    653            case(37) ; flat=resul1
    654            case(38) ; ts=resul1
    655            case(39) ; ustar=resul1
    656          end select
    657        enddo
    658 
    659          return
    660          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
    661651!======================================================================
    662       subroutine read2_cas(nid,nlevel,ntime,                                       &
    663      &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
    664      &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    665      &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
    666      &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    667      &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    668 
    669 !program reading forcing of the case study
    670       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
    671662#include "netcdf.inc"
    672663
    673       integer ntime,nlevel
    674 
    675       real ap(nlevel+1),bp(nlevel+1)
    676       real zz(nlevel,ntime),zzh(nlevel+1)
    677       real pp(nlevel,ntime),pph(nlevel+1)
    678       real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    679       real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    680       real u(nlevel,ntime),v(nlevel,ntime)
    681       real ug(nlevel,ntime),vg(nlevel,ntime)
    682       real vitw(nlevel,ntime),omega(nlevel,ntime)
    683       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    684       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    685       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    686       real dtrad(nlevel,ntime)
    687       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    688       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    689       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    690       real flat(ntime),sens(ntime),ustar(ntime)
    691       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    692       real ts(ntime),ps(ntime),tke(ntime)
    693       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
    694       real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    695 
    696 
    697       integer nid, ierr,ierr1,ierr2,rid,i
    698       integer nbvar3d
    699       parameter(nbvar3d=62)
    700       integer var3didin(nbvar3d),missing_var(nbvar3d)
    701       character*12 name_var(1:nbvar3d)
    702       data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    703      &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    704      &'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
    705      'rh',&
    706      &'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
    707      &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
    708      &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
    709       do i=1,nbvar3d
    710         missing_var(i)=0.
    711       enddo
    712 
    713 !-----------------------------------------------------------------------
    714        do i=1,nbvar3d
    715          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    716          if(ierr/=NF_NOERR) then
    717            print *,'Variable manquante dans cas.nc:',i,name_var(i)
    718            ierr=NF_NOERR
    719            missing_var(i)=1
    720          else
    721 !-----------------------------------------------------------------------
    722            if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    723 #ifdef NC_DOUBLE
    724            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)
    725 #else
    726            ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)
    727 #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])
    728715           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    729716           if(ierr/=NF_NOERR) then
    … …  
    731718              stop "getvarup"
    732719           endif
    733 !-----------------------------------------------------------------------
    734            else if(i.gt.4.and.i.LE.45) then   ! Lecture des variables en (time,nlevel,lat,lon)
    735 #ifdef NC_DOUBLE
    736            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    737 #else
    738            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    739 #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])
    740723           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    741724           if(ierr/=NF_NOERR) then
    … …  
    743726              stop "getvarup"
    744727           endif
    745 !-----------------------------------------------------------------------
    746            else if (i.gt.45.and.i.LE.51) then   ! Lecture des variables en (time,lat,lon)
    747 #ifdef NC_DOUBLE
    748            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)
    749 #else
    750            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)
    751 #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])
    752731           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    753732           if(ierr/=NF_NOERR) then
    … …  
    755734              stop "getvarup"
    756735           endif
    757 !-----------------------------------------------------------------------
    758            else     ! Lecture des constantes (lat,lon)
    759 #ifdef NC_DOUBLE
    760            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)
    761 #else
    762            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)
    763 #endif
     736           !-----------------------------------------------------------------------
     737        else     ! Lecture des constantes (lat,lon)
     738           ierr = NF90_GET_VAR(nid,var3didin(i),resul3)
    764739           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    765740           if(ierr/=NF_NOERR) then
    … …  
    767742              stop "getvarup"
    768743           endif
    769            endif
    770          endif
    771 !-----------------------------------------------------------------------
    772          select case(i)
    773            case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    774            case(2) ; bp=apbp
    775            case(3) ; zzh=apbp
    776            case(4) ; pph=apbp
    777            case(5) ; vitw=resul    ! donnees indexees en nlevel,time
    778            case(6) ; omega=resul
    779            case(7) ; ug=resul
    780            case(8) ; vg=resul
    781            case(9) ; du=resul
    782            case(10) ; hu=resul
    783            case(11) ; vu=resul
    784            case(12) ; dv=resul
    785            case(13) ; hv=resul
    786            case(14) ; vv=resul
    787            case(15) ; dt=resul
    788            case(16) ; ht=resul
    789            case(17) ; vt=resul
    790            case(18) ; dq=resul
    791            case(19) ; hq=resul
    792            case(20) ; vq=resul
    793            case(21) ; dth=resul
    794            case(22) ; hth=resul
    795            case(23) ; vth=resul
    796            case(24) ; hthl=resul
    797            case(25) ; dr=resul
    798            case(26) ; hr=resul
    799            case(27) ; vr=resul
    800            case(28) ; dtrad=resul
    801            case(29) ; q1=resul
    802            case(30) ; q2=resul
    803            case(31) ; uw=resul
    804            case(32) ; vw=resul
    805            case(33) ; rh=resul
    806            case(34) ; zz=resul      ! donnees en time,nlevel pour profil initial
    807            case(35) ; pp=resul
    808            case(36) ; temp=resul
    809            case(37) ; theta=resul
    810            case(38) ; thv=resul
    811            case(39) ; thl=resul
    812            case(40) ; qv=resul
    813            case(41) ; ql=resul
    814            case(42) ; qi=resul
    815            case(43) ; rv=resul
    816            case(44) ; u=resul
    817            case(45) ; v=resul
    818            case(46) ; sens=resul2   ! donnees indexees en time
    819            case(47) ; flat=resul2
    820            case(48) ; ts=resul2
    821            case(49) ; ps=resul2
    822            case(50) ; ustar=resul2
    823            case(51) ; tke=resul2
    824            case(52) ; orog_cas=resul3      ! constantes
    825            case(53) ; albedo_cas=resul3
    826            case(54) ; emiss_cas=resul3
    827            case(55) ; t_skin_cas=resul3
    828            case(56) ; q_skin_cas=resul3
    829            case(57) ; mom_rough=resul3
    830            case(58) ; heat_rough=resul3
    831            case(59) ; o3_cas=resul3       
    832            case(60) ; rugos_cas=resul3
    833            case(61) ; clay_cas=resul3
    834            case(62) ; sand_cas=resul3
    835          end select
    836          resul=0.
    837          resul1=0.
    838          resul2=0.
    839          resul3=0.
    840        enddo
    841 !-----------------------------------------------------------------------
    842 
    843 
    844          return
    845          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
    846821
    847822!======================================================================
    848       subroutine old_read_SCM(nid,nlevel,ntime,                                       &
    849      &     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
    850      &     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
    851      &     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
    852      &     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
    853      &     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
    854 
    855 !program reading forcing of the case study
    856       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
    857833#include "netcdf.inc"
    858834
    859       integer ntime,nlevel,k,t
    860 
    861       real ap(nlevel+1),bp(nlevel+1)
    862       real zz(nlevel,ntime),zzh(nlevel+1)
    863       real pp(nlevel,ntime),pph(nlevel+1)
    864 !profils initiaux
    865       real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
    866       real pp0(nlevel)   
    867       real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
    868       real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
    869       real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
    870       real ug(nlevel,ntime),vg(nlevel,ntime)
    871       real vitw(nlevel,ntime),omega(nlevel,ntime)
    872       real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
    873       real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
    874       real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
    875       real dtrad(nlevel,ntime)
    876       real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
    877       real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
    878       real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
    879       real flat(ntime),sens(ntime),ustar(ntime)
    880       real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
    881       real ts(ntime),ps(ntime)
    882       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
    883       real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
    884 
    885 
    886       integer nid, ierr,ierr1,ierr2,rid,i
    887       integer nbvar3d
    888       parameter(nbvar3d=70)
    889       integer var3didin(nbvar3d),missing_var(nbvar3d)
    890       character*13 name_var(1:nbvar3d)
    891       data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    892      &'temp','qv','ql','qi','u','v','tke','pressure',&
    893      &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    894      &'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
    895      'rh',&
    896      &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
    897      &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
    898      &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
    899       do i=1,nbvar3d
    900         missing_var(i)=0.
    901       enddo
    902 
    903 !-----------------------------------------------------------------------
    904 
    905      print*,'ON EST LA'
    906        do i=1,nbvar3d
    907          ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i))
    908          if(ierr/=NF_NOERR) then
    909            print *,'Variable manquante dans cas.nc:',i,name_var(i)
    910            ierr=NF_NOERR
    911            missing_var(i)=1
    912          else
    913 !-----------------------------------------------------------------------
    914            if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    915 #ifdef NC_DOUBLE
    916            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)
    917 #else
    918            ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)
    919 #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)
    920892           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    921893           if(ierr/=NF_NOERR) then
    … …  
    923895              stop "getvarup"
    924896           endif
    925 !-----------------------------------------------------------------------
    926            else if(i.gt.4.and.i.LE.12) then   ! Lecture des variables en (time,nlevel,lat,lon)
    927 #ifdef NC_DOUBLE
    928            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)
    929 #else
    930            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)
    931 #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)
    932900           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    933901           if(ierr/=NF_NOERR) then
    … …  
    935903              stop "getvarup"
    936904           endif
    937          print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    938 !-----------------------------------------------------------------------
    939            else if(i.gt.12.and.i.LE.54) then   ! Lecture des variables en (time,nlevel,lat,lon)
    940 #ifdef NC_DOUBLE
    941            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)
    942 #else
    943            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)
    944 #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)
    945909           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    946910           if(ierr/=NF_NOERR) then
    … …  
    948912              stop "getvarup"
    949913           endif
    950          print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    951 !-----------------------------------------------------------------------
    952            else if (i.gt.54.and.i.LE.65) then   ! Lecture des variables en (time,lat,lon)
    953 #ifdef NC_DOUBLE
    954            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)
    955 #else
    956            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)
    957 #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)
    958918           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    959919           if(ierr/=NF_NOERR) then
    … …  
    961921              stop "getvarup"
    962922           endif
    963          print*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
    964 !-----------------------------------------------------------------------
    965            else     ! Lecture des constantes (lat,lon)
    966 #ifdef NC_DOUBLE
    967            ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)
    968 #else
    969            ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)
    970 #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)
    971927           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
    972928           if(ierr/=NF_NOERR) then
    … …  
    974930              stop "getvarup"
    975931           endif
    976          print*,'Lecture de la variable #i ',i,name_var(i),resul3
    977            endif
    978          endif
    979 !-----------------------------------------------------------------------
    980          select case(i)
    981          !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
    982          ! case(2) ; bp=apbp
    983            case(3) ; zzh=apbp
    984            case(4) ; pph=apbp
    985            case(5) ; temp0=resul1    ! donnees initiales
    986            case(6) ; qv0=resul1
    987            case(7) ; ql0=resul1
    988            case(8) ; qi0=resul1
    989            case(9) ; u0=resul1
    990            case(10) ; v0=resul1
    991            case(11) ; tke0=resul1
    992            case(12) ; pp0=resul1
    993            case(13) ; vitw=resul    ! donnees indexees en nlevel,time
    994            case(14) ; omega=resul
    995            case(15) ; ug=resul
    996            case(16) ; vg=resul
    997            case(17) ; du=resul
    998            case(18) ; hu=resul
    999            case(19) ; vu=resul
    1000            case(20) ; dv=resul
    1001            case(21) ; hv=resul
    1002            case(22) ; vv=resul
    1003            case(23) ; dt=resul
    1004            case(24) ; ht=resul
    1005            case(25) ; vt=resul
    1006            case(26) ; dq=resul
    1007            case(27) ; hq=resul
    1008            case(28) ; vq=resul
    1009            case(29) ; dth=resul
    1010            case(30) ; hth=resul
    1011            case(31) ; vth=resul
    1012            case(32) ; hthl=resul
    1013            case(33) ; dr=resul
    1014            case(34) ; hr=resul
    1015            case(35) ; vr=resul
    1016            case(36) ; dtrad=resul
    1017            case(37) ; q1=resul
    1018            case(38) ; q2=resul
    1019            case(39) ; uw=resul
    1020            case(40) ; vw=resul
    1021            case(41) ; rh=resul
    1022            case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
    1023            case(43) ; pp=resul
    1024            case(44) ; temp=resul
    1025            case(45) ; theta=resul
    1026            case(46) ; thv=resul
    1027            case(47) ; thl=resul
    1028            case(48) ; qv=resul
    1029            case(49) ; ql=resul
    1030            case(50) ; qi=resul
    1031            case(51) ; rv=resul
    1032            case(52) ; u=resul
    1033            case(53) ; v=resul
    1034            case(54) ; tke=resul
    1035            case(55) ; sens=resul2   ! donnees indexees en time
    1036            case(56) ; flat=resul2
    1037            case(57) ; ts=resul2
    1038            case(58) ; ps=resul2
    1039            case(59) ; ustar=resul2
    1040            case(60) ; orog_cas=resul3      ! constantes
    1041            case(61) ; albedo_cas=resul3
    1042            case(62) ; emiss_cas=resul3
    1043            case(63) ; t_skin_cas=resul3
    1044            case(64) ; q_skin_cas=resul3
    1045            case(65) ; mom_rough=resul3
    1046            case(66) ; heat_rough=resul3
    1047            case(67) ; o3_cas=resul3       
    1048            case(68) ; rugos_cas=resul3
    1049            case(69) ; clay_cas=resul3
    1050            case(70) ; sand_cas=resul3
    1051          end select
    1052          resul=0.
    1053          resul1=0.
    1054          resul2=0.
    1055          resul3=0.
    1056        enddo
    1057          print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
    1058          print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
    1059 
    1060 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
    1061        do t=1,ntime
    1062           do k=1,nlevel
    1063              temp(k,t)=temp0(k)
    1064              qv(k,t)=qv0(k)
    1065              ql(k,t)=ql0(k)
    1066              qi(k,t)=qi0(k)
    1067              u(k,t)=u0(k)
    1068              v(k,t)=v0(k)
    1069              tke(k,t)=tke0(k)
    1070           enddo
    1071        enddo
    1072 !-----------------------------------------------------------------------
    1073 
    1074          return
    1075          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
    10761032!======================================================================
    10771033
    10781034!======================================================================
    1079         SUBROUTINE interp_case_time2(day,day1,annee_ref                &
    1080 !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
    1081      &         ,nt_cas,nlev_cas                                       &
    1082      &         ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
    1083      &         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
    1084      &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
    1085      &         ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
    1086      &         ,uw_cas,vw_cas,q1_cas,q2_cas                           &
    1087      &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
    1088      &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
    1089      &         ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
    1090      &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
    1091      &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
    1092      &         ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
    1093      &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
    1094          
    1095 
    1096         implicit none
    1097 
    1098 !---------------------------------------------------------------------------------------
    1099 ! Time interpolation of a 2D field to the timestep corresponding to day
    1100 !
    1101 ! day: current julian day (e.g. 717538.2)
    1102 ! day1: first day of the simulation
    1103 ! nt_cas: total nb of data in the forcing
    1104 ! pdt_cas: total time interval (in sec) between 2 forcing data
    1105 !---------------------------------------------------------------------------------------
     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  !---------------------------------------------------------------------------------------
    11061062
    11071063#include "compar1d.h"
    11081064#include "date_cas.h"
    11091065
    1110 ! inputs:
    1111         integer annee_ref
    1112         integer nt_cas,nlev_cas
    1113         real day, day1,day_cas
    1114         real ts_cas(nt_cas),ps_cas(nt_cas)
    1115         real plev_cas(nlev_cas,nt_cas)
    1116         real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
    1117         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1118         real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1119         real vitw_cas(nlev_cas,nt_cas)
    1120         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1121         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1122         real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1123         real dtrad_cas(nlev_cas,nt_cas)
    1124         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1125         real lat_cas(nt_cas)
    1126         real sens_cas(nt_cas)
    1127         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1128         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    1129 
    1130 ! outputs:
    1131         real plev_prof_cas(nlev_cas)
    1132         real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
    1133         real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1134         real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1135         real vitw_prof_cas(nlev_cas)
    1136         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1137         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1138         real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1139         real dtrad_prof_cas(nlev_cas)
    1140         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1141         real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    1142         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    1143 ! local:
    1144         integer it_cas1, it_cas2,k
    1145         real timeit,time_cas1,time_cas2,frac
    1146 
    1147 
    1148         print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    1149 
    1150 ! On teste si la date du cas AMMA est correcte.
    1151 ! C est pour memoire car en fait les fichiers .def
    1152 ! sont censes etre corrects.
    1153 ! A supprimer a terme (MPL 20150623)
    1154 !     if ((forcing_type.eq.10).and.(1.eq.0)) then
    1155 ! Check that initial day of the simulation consistent with AMMA case:
    1156 !      if (annee_ref.ne.2006) then
    1157 !       print*,'Pour AMMA, annee_ref doit etre 2006'
    1158 !       print*,'Changer annee_ref dans run.def'
    1159 !       stop
    1160 !      endif
    1161 !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
    1162 !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    1163 !       print*,'Changer dayref dans run.def'
    1164 !       stop
    1165 !      endif
    1166 !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
    1167 !       print*,'AMMA a fini le 11 juillet'
    1168 !       print*,'Changer dayref ou nday dans run.def'
    1169 !       stop
    1170 !      endif
    1171 !      endif
    1172 
    1173 ! Determine timestep relative to the 1st day:
    1174 !       timeit=(day-day1)*86400.
    1175 !       if (annee_ref.eq.1992) then
    1176 !        timeit=(day-day_cas)*86400.
    1177 !       else
    1178 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    1179 !       endif
    1180       timeit=(day-day_ju_ini_cas)*86400
    1181       print *,'day=',day
    1182       print *,'day_ju_ini_cas=',day_ju_ini_cas
    1183       print *,'pdt_cas=',pdt_cas
    1184       print *,'timeit=',timeit
    1185       print *,'nt_cas=',nt_cas
    1186 
    1187 ! Determine the closest observation times:
    1188 !       it_cas1=INT(timeit/pdt_cas)+1
    1189 !       it_cas2=it_cas1 + 1
    1190 !       time_cas1=(it_cas1-1)*pdt_cas
    1191 !       time_cas2=(it_cas2-1)*pdt_cas
    1192 
    1193        it_cas1=INT(timeit/pdt_cas)+1
    1194        IF (it_cas1 .EQ. nt_cas) THEN
    1195        it_cas2=it_cas1
    1196        ELSE
    1197        it_cas2=it_cas1 + 1
    1198        ENDIF
    1199        time_cas1=(it_cas1-1)*pdt_cas
    1200        time_cas2=(it_cas2-1)*pdt_cas
    1201        print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    1202 
    1203        if (it_cas1 .gt. nt_cas) then
    1204         write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    1205      &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    1206         stop
    1207        endif
    1208 
    1209 ! time interpolation:
    1210        IF (it_cas1 .EQ. it_cas2) THEN
    1211           frac=0.
    1212        ELSE
    1213           frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    1214           frac=max(frac,0.0)
    1215        ENDIF
    1216 
    1217        lat_prof_cas = lat_cas(it_cas2)                                       &
    1218      &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    1219        sens_prof_cas = sens_cas(it_cas2)                                     &
    1220      &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    1221        ts_prof_cas = ts_cas(it_cas2)                                         &
    1222      &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    1223        ustar_prof_cas = ustar_cas(it_cas2)                                   &
    1224      &          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    1225 
    1226        do k=1,nlev_cas
    1227         plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
    1228      &          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    1229         t_prof_cas(k) = t_cas(k,it_cas2)                               &
    1230      &          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    1231         q_prof_cas(k) = q_cas(k,it_cas2)                               &
    1232      &          -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
    1233         u_prof_cas(k) = u_cas(k,it_cas2)                               &
    1234      &          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    1235         v_prof_cas(k) = v_cas(k,it_cas2)                               &
    1236      &          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    1237         ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    1238      &          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    1239         vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    1240      &          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    1241         vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
    1242      &          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    1243         du_prof_cas(k) = du_cas(k,it_cas2)                                   &
    1244      &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    1245         hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
    1246      &          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    1247         vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
    1248      &          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    1249         dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
    1250      &          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    1251         hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
    1252      &          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    1253         vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
    1254      &          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    1255         dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
    1256      &          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    1257         ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
    1258      &          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    1259         vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
    1260      &          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    1261         dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
    1262      &          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    1263         dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
    1264      &          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    1265         hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
    1266      &          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    1267         vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
    1268      &          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    1269        uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
    1270      &          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    1271        vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
    1272      &          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1273        q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
    1274      &          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1275        q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
    1276      &          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1277         enddo
    1278 
    1279         return
    1280         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
    12811237
    12821238!**********************************************************************************************
    1283         SUBROUTINE interp2_case_time(day,day1,annee_ref                           &
    1284 !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
    1285      &         ,nt_cas,nlev_cas                                                   &
    1286      &         ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
    1287      &         ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
    1288      &         ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
    1289      &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
    1290      &         ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
    1291      &         ,lat_cas,sens_cas,ustar_cas                                        &
    1292      &         ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
    1293 !
    1294      &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
    1295      &         ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
    1296      &         ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
    1297      &         ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
    1298      &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
    1299      &         ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
    1300      &         ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
    1301      &         ,lat_prof_cas,sens_prof_cas                                        &
    1302      &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
    1303          
    1304 
    1305         implicit none
    1306 
    1307 !---------------------------------------------------------------------------------------
    1308 ! Time interpolation of a 2D field to the timestep corresponding to day
    1309 !
    1310 ! day: current julian day (e.g. 717538.2)
    1311 ! day1: first day of the simulation
    1312 ! nt_cas: total nb of data in the forcing
    1313 ! pdt_cas: total time interval (in sec) between 2 forcing data
    1314 !---------------------------------------------------------------------------------------
     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  !---------------------------------------------------------------------------------------
    13151271
    13161272#include "compar1d.h"
    13171273#include "date_cas.h"
    13181274
    1319 ! inputs:
    1320         integer annee_ref
    1321         integer nt_cas,nlev_cas
    1322         real day, day1,day_cas
    1323         real ts_cas(nt_cas),ps_cas(nt_cas)
    1324         real plev_cas(nlev_cas,nt_cas)
    1325         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)
    1326         real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
    1327         real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
    1328         real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
    1329         real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
    1330         real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
    1331         real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
    1332         real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
    1333         real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
    1334         real dtrad_cas(nlev_cas,nt_cas)
    1335         real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
    1336         real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
    1337         real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
    1338         real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
    1339 
    1340 ! outputs:
    1341         real plev_prof_cas(nlev_cas)
    1342         real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
    1343         real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
    1344         real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
    1345         real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
    1346         real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
    1347         real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
    1348         real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
    1349         real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
    1350         real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
    1351         real dtrad_prof_cas(nlev_cas)
    1352         real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
    1353         real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
    1354         real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
    1355 ! local:
    1356         integer it_cas1, it_cas2,k
    1357         real timeit,time_cas1,time_cas2,frac
    1358 
    1359 
    1360         print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
    1361 !       do k=1,nlev_cas
    1362 !       print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
    1363 !       enddo
    1364 
    1365 ! On teste si la date du cas AMMA est correcte.
    1366 ! C est pour memoire car en fait les fichiers .def
    1367 ! sont censes etre corrects.
    1368 ! A supprimer a terme (MPL 20150623)
    1369 !     if ((forcing_type.eq.10).and.(1.eq.0)) then
    1370 ! Check that initial day of the simulation consistent with AMMA case:
    1371 !      if (annee_ref.ne.2006) then
    1372 !       print*,'Pour AMMA, annee_ref doit etre 2006'
    1373 !       print*,'Changer annee_ref dans run.def'
    1374 !       stop
    1375 !      endif
    1376 !      if (annee_ref.eq.2006 .and. day1.lt.day_cas) then
    1377 !       print*,'AMMA a debute le 10 juillet 2006',day1,day_cas
    1378 !       print*,'Changer dayref dans run.def'
    1379 !       stop
    1380 !      endif
    1381 !      if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then
    1382 !       print*,'AMMA a fini le 11 juillet'
    1383 !       print*,'Changer dayref ou nday dans run.def'
    1384 !       stop
    1385 !      endif
    1386 !      endif
    1387 
    1388 ! Determine timestep relative to the 1st day:
    1389 !       timeit=(day-day1)*86400.
    1390 !       if (annee_ref.eq.1992) then
    1391 !        timeit=(day-day_cas)*86400.
    1392 !       else
    1393 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    1394 !       endif
    1395       timeit=(day-day_ju_ini_cas)*86400
    1396       print *,'day=',day
    1397       print *,'day_ju_ini_cas=',day_ju_ini_cas
    1398       print *,'pdt_cas=',pdt_cas
    1399       print *,'timeit=',timeit
    1400       print *,'nt_cas=',nt_cas
    1401 
    1402 ! Determine the closest observation times:
    1403 !       it_cas1=INT(timeit/pdt_cas)+1
    1404 !       it_cas2=it_cas1 + 1
    1405 !       time_cas1=(it_cas1-1)*pdt_cas
    1406 !       time_cas2=(it_cas2-1)*pdt_cas
    1407 
    1408        it_cas1=INT(timeit/pdt_cas)+1
    1409        IF (it_cas1 .EQ. nt_cas) THEN
    1410        it_cas2=it_cas1
    1411        ELSE
    1412        it_cas2=it_cas1 + 1
    1413        ENDIF
    1414        time_cas1=(it_cas1-1)*pdt_cas
    1415        time_cas2=(it_cas2-1)*pdt_cas
    1416       print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
    1417       print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    1418 
    1419        if (it_cas1 .gt. nt_cas) then
    1420         write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    1421      &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    1422         stop
    1423        endif
    1424 
    1425 ! time interpolation:
    1426        IF (it_cas1 .EQ. it_cas2) THEN
    1427           frac=0.
    1428        ELSE
    1429           frac=(time_cas2-timeit)/(time_cas2-time_cas1)
    1430           frac=max(frac,0.0)
    1431        ENDIF
    1432 
    1433        lat_prof_cas = lat_cas(it_cas2)                                   &
    1434      &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
    1435        sens_prof_cas = sens_cas(it_cas2)                                 &
    1436      &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    1437        tke_prof_cas = tke_cas(it_cas2)                                   &
    1438      &          -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
    1439        ts_prof_cas = ts_cas(it_cas2)                                     &
    1440      &          -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
    1441        ustar_prof_cas = ustar_cas(it_cas2)                               &
    1442      &          -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
    1443 
    1444        do k=1,nlev_cas
    1445         plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
    1446      &          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
    1447         t_prof_cas(k) = t_cas(k,it_cas2)                                 &       
    1448      &          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
    1449         print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
    1450         theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                     
    1451      &          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
    1452         thv_prof_cas(k) = thv_cas(k,it_cas2)                             &         
    1453      &          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
    1454         thl_prof_cas(k) = thl_cas(k,it_cas2)                             &             
    1455      &          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
    1456         qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
    1457      &          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
    1458         ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
    1459      &          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
    1460         qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
    1461      &          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
    1462         u_prof_cas(k) = u_cas(k,it_cas2)                                 &
    1463      &          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
    1464         v_prof_cas(k) = v_cas(k,it_cas2)                                 &
    1465      &          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
    1466         ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
    1467      &          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
    1468         vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
    1469      &          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
    1470         vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
    1471      &          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
    1472         omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
    1473      &          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
    1474         du_prof_cas(k) = du_cas(k,it_cas2)                               &
    1475      &          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
    1476         hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
    1477      &          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
    1478         vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
    1479      &          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
    1480         dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
    1481      &          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
    1482         hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
    1483      &          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
    1484         vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
    1485      &          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
    1486         dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
    1487      &          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
    1488         ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
    1489      &          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
    1490         vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
    1491      &          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
    1492         dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
    1493      &          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
    1494         hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
    1495      &          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
    1496         vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
    1497      &          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
    1498         dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
    1499      &          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
    1500         dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
    1501      &          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
    1502         hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
    1503      &          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
    1504         vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
    1505      &          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
    1506        uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
    1507      &          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
    1508        vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
    1509      &          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
    1510        q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
    1511      &          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
    1512        q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
    1513      &          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
    1514         enddo
    1515 
    1516         return
    1517         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
    15181474
    15191475!**********************************************************************************************

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

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

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

    r3605 r4368  
    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/Ocean_skin/libf/phylmd/dyn1d/old_1D_read_forc_cases.h

    r3798 r4368  
    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/Ocean_skin/libf/phylmd/dyn1d/old_lmdz1d.F90

    r4013 r4368  
    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'
    … …  
    889889        clwcon=0.
    890890        zmax0 = 0.
    891         zmea=0.
     891        zmea=zsurf
    892892        zstd=0.
    893893        zsig=0.
    … …  
    10331033!
    10341034!=====================================================================
     1035#ifdef OUTPUT_PHYS_SCM
    10351036       CALL iophys_ini(timestep)
     1037#endif
    10361038! START OF THE TEMPORAL LOOP :
    10371039!=====================================================================
    … …  
    10501052
    10511053!---------------------------------------------------------------------
    1052 ! Interpolation of forcings in time and onto model levels
    1053 !---------------------------------------------------------------------
    1054 
    1055 #include "old_1D_interp_cases.h"
    1056 
    1057       if (forcing_GCM2SCM) then
    1058         write (*,*) 'forcing_GCM2SCM not yet implemented'
    1059         stop 'in time loop'
    1060       endif ! forcing_GCM2SCM
    1061 
    1062 !---------------------------------------------------------------------
    10631054!  Geopotential :
    10641055!---------------------------------------------------------------------
    … …  
    10691060     &    (play(l)-play(l+1))/(play(l)+play(l+1))
    10701061        enddo
     1062
     1063!---------------------------------------------------------------------
     1064! Interpolation of forcings in time and onto model levels
     1065!---------------------------------------------------------------------
     1066
     1067#include "old_1D_interp_cases.h"
     1068
     1069      if (forcing_GCM2SCM) then
     1070        write (*,*) 'forcing_GCM2SCM not yet implemented'
     1071        stop 'in time loop'
     1072      endif ! forcing_GCM2SCM
     1073
     1074!!!!---------------------------------------------------------------------
     1075!!!!  Geopotential :
     1076!!!!---------------------------------------------------------------------
     1077!!!
     1078!!!        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
     1079!!!        do l = 1, llm-1
     1080!!!          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
     1081!!!     &    (play(l)-play(l+1))/(play(l)+play(l+1))
     1082!!!        enddo
    10711083
    10721084!---------------------------------------------------------------------
    … …  
    12761288     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
    12771289
    1278 print*,'OLDLMDZ1D IOPH'
     1290#ifdef OUTPUT_PHYS_SCM
    12791291      CALL iophys_ecrit('d_t_adv',klev,'d_t_adv','m/s',d_t_adv)
    12801292      CALL iophys_ecrit('d_t_nudge',klev,'d_t_nudge','m/s',d_t_nudge)
     1293#endif
    12811294
    12821295      endif  ! forcing_sandu or forcing_astex

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

    r4013 r4368  
    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
    … …  
    654647        clwcon=0.
    655648        zmax0 = 0.
    656         zmea=0.
     649        zmea=zsurf
    657650        zstd=0.
    658651        zsig=0.
    … …  
    815808!  Geopotential :
    816809!---------------------------------------------------------------------
    817 !        phis(1)=zsurf*RG
     810        phis(1)=zsurf*RG
    818811!        phi(1)=phis(1)+RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
     812
     813        ! Calculate geopotential from the ground surface since phi and phis are added in physiq_mod
    819814        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
    820815
    … …  
    823818     &    (play(l)-play(l+1))/(play(l)+play(l+1))
    824819        enddo
    825 
    826820
    827821!---------------------------------------------------------------------
    … …  
    852846      d_t_adv(:)=d_t_adv(:)+d_t_vert_adv(:)
    853847      d_q_adv(:,1)=d_q_adv(:,1)+d_q_vert_adv(:,1)
    854 
    855       print*,'OMEGA ',w_adv(10),z_adv(10)
    856 
     848   
    857849   ENDIF
    858850
    … …  
    938930!---------------------------------------------------------------------
    939931!  Nudging
     932!  EV: rewrite the section to account for a time- and height-varying
     933!  nudging
    940934!---------------------------------------------------------------------
    941935      d_t_nudge(:) = 0.
    … …  
    943937      d_v_nudge(:) = 0.
    944938      d_q_nudge(:,:) = 0.
     939
    945940      DO l=1,llm
    946          IF ( play(l) < p_nudging_u .AND. nint(nudging_u) /= 0 ) &
     941
     942         IF (nudging_u .LT. 0) THEN
     943             
     944             d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))*invtau_u_nudg_mod_cas(l)
     945       
     946         ELSE
     947
     948             IF ( play(l) < p_nudging_u .AND. nint(nudging_u) /= 0 ) &
    947949             & d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u
    948          IF ( play(l) < p_nudging_v .AND. nint(nudging_v) /= 0 ) &
     950
     951         ENDIF
     952
     953
     954         IF (nudging_v .LT. 0) THEN
     955             
     956             d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))*invtau_v_nudg_mod_cas(l)
     957       
     958         ELSE
     959
     960
     961             IF ( play(l) < p_nudging_v .AND. nint(nudging_v) /= 0 ) &
    949962             & d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v
    950          IF ( play(l) < p_nudging_t .AND. nint(nudging_t) /= 0 ) &
     963
     964         ENDIF
     965
     966
     967         IF (nudging_t .LT. 0) THEN
     968             
     969             d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))*invtau_temp_nudg_mod_cas(l)
     970       
     971         ELSE
     972
     973
     974             IF ( play(l) < p_nudging_t .AND. nint(nudging_t) /= 0 ) &
    951975             & d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t
    952          IF ( play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0 ) &
     976
     977          ENDIF
     978
     979
     980         IF (nudging_qv .LT. 0) THEN
     981             
     982             d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))*invtau_qv_nudg_mod_cas(l)
     983       
     984         ELSE
     985
     986             IF ( play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0 ) &
    953987             & d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))/nudging_qv
     988
     989         ENDIF
     990
    954991      ENDDO
    955992
    … …  
    957994!  Optional outputs
    958995!---------------------------------------------------------------------
     996
    959997#ifdef OUTPUT_PHYS_SCM
    960998      CALL iophys_ecrit('w_adv',klev,'w_adv','K/day',w_adv)
Note: See TracChangeset for help on using the changeset viewer.