Ignore:
Timestamp:
Jul 18, 2013, 10:20:28 AM (11 years ago)
Author:
Ehouarn Millour
Message:

Version testing basee sur la r1794

Testing release based on r1794

Location:
LMDZ5/branches/testing
Files:
15 deleted
109 edited
12 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3d/ce0l.F90

    r1665 r1795  
    2020  USE comgeomphy
    2121  USE infotrac
     22  USE indice_sol_mod
    2223
    2324#ifdef CPP_IOIPSL
    … …  
    3637#include "dimensions.h"
    3738#include "paramet.h"
    38 #include "indicesol.h"
     39!#include "indicesol.h"
    3940#include "iniprint.h"
    4041#include "temps.h"

  • LMDZ5/branches/testing/libf/dyn3d/comconst.h

    r1707 r1795  
    66
    77      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
    8      &                 iflag_top_bound
     8     &                 iflag_top_bound,mode_top_bound
    99      COMMON/comconstr/dtvr,daysec,                                     &
    1010     & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
    … …  
    3030      REAL omeg ! (rad/s) rotation rate of the planet
    3131      REAL dissip_factz,dissip_deltaz,dissip_zref
    32       INTEGER iflag_top_bound
    33       REAL tau_top_bound
     32! top_bound sponge:
     33      INTEGER iflag_top_bound ! sponge type
     34      INTEGER mode_top_bound  ! sponge mode
     35      REAL tau_top_bound ! inverse of sponge characteristic time scale (Hz)
    3436      REAL daylen ! length of solar day, in 'standard' day length
    3537      REAL year_day ! Number of standard days in a year

  • LMDZ5/branches/testing/libf/dyn3d/comvert.h

    r1669 r1795  
    2323      real bps    ! hybrid sigma contribution at mid-layers
    2424      real scaleheight ! atmospheric (reference) scale height (km)
    25       real pseudoalt ! for planets
     25      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
     26                     ! preff and scaleheight
    2627
    2728      integer disvert_type ! type of vertical discretization:

  • LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F

    r1707 r1795  
    307307       CALL getin('dissip_zref',dissip_zref )
    308308
     309! top_bound sponge: only active if ok_strato=.true. and iflag_top_bound!=0
     310!                   iflag_top_bound=0 for no sponge
     311!                   iflag_top_bound=1 for sponge over 4 topmost layers
     312!                   iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
    309313       iflag_top_bound=1
     314       CALL getin('iflag_top_bound',iflag_top_bound)
     315
     316! mode_top_bound : fields towards which sponge relaxation will be done:
     317!                  mode_top_bound=0: no relaxation
     318!                  mode_top_bound=1: u and v relax towards 0
     319!                  mode_top_bound=2: u and v relax towards their zonal mean
     320!                  mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     321       mode_top_bound=3
     322       CALL getin('mode_top_bound',mode_top_bound)
     323
     324! top_bound sponge : inverse of charactericstic relaxation time scale for sponge
    310325       tau_top_bound=1.e-5
    311        CALL getin('iflag_top_bound',iflag_top_bound)
    312326       CALL getin('tau_top_bound',tau_top_bound)
    313327

  • LMDZ5/branches/testing/libf/dyn3d/gcm.F

    r1707 r1795  
    1616      USE infotrac
    1717      USE control_mod
     18
     19#ifdef INCA
     20! Only INCA needs these informations (from the Earth's physics)
     21      USE indice_sol_mod
     22#endif
    1823
    1924!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    7782#ifdef INCA
    7883! Only INCA needs these informations (from the Earth's physics)
    79 #include "indicesol.h"
     84!#include "indicesol.h"
    8085#endif
    8186      INTEGER         longcles

  • LMDZ5/branches/testing/libf/dyn3d/inigeom.F

    r1403 r1795  
    426426         radclatm = 0.5* rad * coslatm
    427427c
     428         ai14            = un4rad2 * coslatp * yprp
     429         ai23            = un4rad2 * coslatm * yprm
    428430         DO 32 i = 1,iim
    429431         xprp            = xprimp025( i )
    430432         xprm            = xprimm025( i )
    431433     
    432          ai14            = un4rad2 * coslatp * yprp
    433          ai23            = un4rad2 * coslatm * yprm
    434434         aireij1 ( i,j ) = ai14 * xprp
    435435         aireij2 ( i,j ) = ai23 * xprp

  • LMDZ5/branches/testing/libf/dyn3d/leapfrog.F

    r1707 r1795  
    436436     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
    437437
    438          IF (ok_strato) THEN
    439            CALL top_bound( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    440          ENDIF
    441        
    442438c      ajout des tendances physiques:
    443439c      ------------------------------
    … …  
    445441     $                  ucov, vcov, teta , q   ,ps ,
    446442     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
     443
     444         IF (ok_strato) THEN
     445           CALL top_bound( vcov,ucov,teta,masse,dtphys)
     446         ENDIF
     447       
    447448c
    448449c  Diagnostique de conservation de l'énergie : difference
    … …  
    476477        ! Sponge layer (if any)
    477478        IF (ok_strato) THEN
    478           dufi(:,:)=0.
    479           dvfi(:,:)=0.
    480           dtetafi(:,:)=0.
    481           dqfi(:,:,:)=0.
    482           dpfi(:)=0.
    483           CALL top_bound(vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    484           CALL addfi( dtvr, leapf, forward   ,
    485      $                  ucov, vcov, teta , q   ,ps ,
    486      $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
     479!          dufi(:,:)=0.
     480!          dvfi(:,:)=0.
     481!          dtetafi(:,:)=0.
     482!          dqfi(:,:,:)=0.
     483!          dpfi(:)=0.
     484!          CALL top_bound(vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
     485           CALL top_bound( vcov,ucov,teta,masse,dtvr)
     486!          CALL addfi( dtvr, leapf, forward   ,
     487!     $                  ucov, vcov, teta , q   ,ps ,
     488!     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    487489        ENDIF ! of IF (ok_strato)
    488490      ENDIF ! of IF (iflag_phys.EQ.2)

  • LMDZ5/branches/testing/libf/dyn3d/temps.h

    r1665 r1795  
    1313! INCLUDE 'temps.h'
    1414
    15       COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
    16      &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
    17      &             start_time
     15      COMMON/temps/ dt, jD_ref, jH_ref, start_time,                     &
     16     &             day_ini, day_end, annee_ref, day_ref,                &
     17     &             itau_dyn, itau_phy, itaufin, calend
    1818
    1919
    2020      INTEGER   itaufin
    21       INTEGER itau_dyn, itau_phy
     21      INTEGER itau_dyn, itau_phy 
    2222      INTEGER day_ini, day_end, annee_ref, day_ref
    2323      REAL      dt, jD_ref, jH_ref, start_time

  • LMDZ5/branches/testing/libf/dyn3d/top_bound.F

    r1279 r1795  
    1       SUBROUTINE top_bound( vcov,ucov,teta,masse, du,dv,dh )
     1!
     2! $Id$
     3!
     4      SUBROUTINE top_bound(vcov,ucov,teta,masse,dt)
    25      IMPLICIT NONE
    36c
    … …  
    2427c
    2528c=======================================================================
    26 c-----------------------------------------------------------------------
    27 c   Declarations:
    28 c   -------------
    2929
    30 ! #include "comgeom.h"
     30! top_bound sponge layer model:
     31! Quenching is modeled as: A(t)=Am+A0*exp(-lambda*t)
     32! where Am is the zonal average of the field (or zero), and lambda the inverse
     33! of the characteristic quenching/relaxation time scale
     34! Thus, assuming Am to be time-independent, field at time t+dt is given by:
     35! A(t+dt)=A(t)-(A(t)-Am)*(1-exp(-lambda*t))
     36! Moreover lambda can be a function of model level (see below), and relaxation
     37! can be toward the average zonal field or just zero (see below).
     38
     39! NB: top_bound sponge is only called from leapfrog if ok_strato=.true.
     40
     41! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst.h)
     42!    iflag_top_bound=0 for no sponge
     43!    iflag_top_bound=1 for sponge over 4 topmost layers
     44!    iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
     45!    mode_top_bound=0: no relaxation
     46!    mode_top_bound=1: u and v relax towards 0
     47!    mode_top_bound=2: u and v relax towards their zonal mean
     48!    mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     49!    tau_top_bound : inverse of charactericstic relaxation time scale at
     50!                       the topmost layer (Hz)
     51
     52
    3153#include "comdissipn.h"
     54#include "iniprint.h"
    3255
    3356c   Arguments:
    3457c   ----------
    3558
    36       REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
    37       REAL masse(iip1,jjp1,llm)
    38       REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
     59      real,intent(inout) :: ucov(iip1,jjp1,llm) ! covariant zonal wind
     60      real,intent(inout) :: vcov(iip1,jjm,llm) ! covariant meridional wind
     61      real,intent(inout) :: teta(iip1,jjp1,llm) ! potential temperature
     62      real,intent(in) :: masse(iip1,jjp1,llm) ! mass of atmosphere
     63      real,intent(in) :: dt ! time step (s) of sponge model
    3964
    4065c   Local:
    … …  
    4469      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
    4570     
    46       INTEGER NDAMP
    47       PARAMETER (NDAMP=4)
    4871      integer i
    49       REAL,SAVE :: rdamp(llm)
    50 !     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     72      REAL,SAVE :: rdamp(llm) ! quenching coefficient
     73      real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
    5174
    5275      LOGICAL,SAVE :: first=.true.
    5376
    5477      INTEGER j,l
    55 
    56 
    57 C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    5878     
    5979      if (iflag_top_bound.eq.0) return
    … …  
    6181      if (first) then
    6282         if (iflag_top_bound.eq.1) then
    63 ! couche eponge dans les 4 dernieres couches du modele
    64              rdamp(:)=0.
    65              rdamp(llm)=tau_top_bound
    66              rdamp(llm-1)=tau_top_bound/2.
    67              rdamp(llm-2)=tau_top_bound/4.
    68              rdamp(llm-3)=tau_top_bound/8.
     83! sponge quenching over the topmost 4 atmospheric layers
     84             lambda(:)=0.
     85             lambda(llm)=tau_top_bound
     86             lambda(llm-1)=tau_top_bound/2.
     87             lambda(llm-2)=tau_top_bound/4.
     88             lambda(llm-3)=tau_top_bound/8.
    6989         else if (iflag_top_bound.eq.2) then
    70 ! couce eponge dans toutes les couches de pression plus faible que
    71 ! 100 fois la pression de la derniere couche
    72              rdamp(:)=tau_top_bound
     90! sponge quenching over topmost layers down to pressures which are
     91! higher than 100 times the topmost layer pressure
     92             lambda(:)=tau_top_bound
    7393     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
    7494         endif
     95
     96! quenching coefficient rdamp(:)
     97!         rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
     98         rdamp(:)=1.-exp(-lambda(:)*dt)
     99
     100         write(lunout,*)'TOP_BOUND mode',mode_top_bound
     101         write(lunout,*)'Sponge layer coefficients'
     102         write(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
     103         do l=1,llm
     104           if (rdamp(l).ne.0.) then
     105             write(lunout,'(6(1pe12.4,1x))')
     106     &        presnivs(l),log(preff/presnivs(l))*scaleheight,
     107     &           1./lambda(l),lambda(l)
     108           endif
     109         enddo
    75110         first=.false.
    76          print*,'TOP_BOUND rdamp=',rdamp
    77       endif
     111      endif ! of if (first)
    78112
    79113      CALL massbar(masse,massebx,masseby)
    80114
    81       do l=1,llm
     115      ! compute zonal average of vcov and u
     116      if (mode_top_bound.ge.2) then
     117       do l=1,llm
    82118        do j=1,jjm
    83119          vzon(j,l)=0.
    84120          zm=0.
    85121          do i=1,iim
    86 ! Rm: on peut travailler directement avec la moyenne zonale de vcov
    87 ! plutot qu'avec celle de v car le coefficient cv qui relie les deux
    88 ! ne varie qu'en latitude
     122! NB: we can work using vcov zonal mean rather than v since the
     123! cv coefficient (which relates the two) only varies with latitudes
    89124            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
    90125            zm=zm+masseby(i,j,l)
    … …  
    92127          vzon(j,l)=vzon(j,l)/zm
    93128        enddo
    94       enddo
     129       enddo
    95130
    96       do l=1,llm
    97         do i=1,iip1
    98           do j=1,jjm
    99             dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
    100           enddo
    101         enddo
    102       enddo
    103 
    104       do l=1,llm
    105         do j=2,jjm
     131       do l=1,llm
     132        do j=2,jjm ! excluding poles
    106133          uzon(j,l)=0.
    107134          zm=0.
    … …  
    112139          uzon(j,l)=uzon(j,l)/zm
    113140        enddo
    114       enddo
     141       enddo
     142      else ! ucov and vcov will relax towards 0
     143        vzon(:,:)=0.
     144        uzon(:,:)=0.
     145      endif ! of if (mode_top_bound.ge.2)
    115146
    116       do l=1,llm
    117         do j=2,jjm
     147      ! compute zonal average of potential temperature, if necessary
     148      if (mode_top_bound.ge.3) then
     149       do l=1,llm
     150        do j=2,jjm ! excluding poles
    118151          zm=0.
    119152          tzon(j,l)=0.
    … …  
    124157          tzon(j,l)=tzon(j,l)/zm
    125158        enddo
    126       enddo
     159       enddo
     160      endif ! of if (mode_top_bound.ge.3)
    127161
    128 C   AMORTISSEMENTS LINEAIRES:
    129 
    130       do l=1,llm
     162      if (mode_top_bound.ge.1) then
     163       ! Apply sponge quenching on vcov:
     164       do l=1,llm
    131165        do i=1,iip1
    132           do j=2,jjm
    133             du(i,j,l)=du(i,j,l)
    134      s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
    135             dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
     166          do j=1,jjm
     167            vcov(i,j,l)=vcov(i,j,l)
     168     &                  -rdamp(l)*(vcov(i,j,l)-vzon(j,l))
    136169          enddo
    137170        enddo
    138       enddo
    139      
     171       enddo
    140172
    141       RETURN
     173       ! Apply sponge quenching on ucov:
     174       do l=1,llm
     175        do i=1,iip1
     176          do j=2,jjm ! excluding poles
     177            ucov(i,j,l)=ucov(i,j,l)
     178     &                  -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
     179          enddo
     180        enddo
     181       enddo
     182      endif ! of if (mode_top_bound.ge.1)
     183
     184      if (mode_top_bound.ge.3) then
     185       ! Apply sponge quenching on teta:
     186       do l=1,llm
     187        do i=1,iip1
     188          do j=2,jjm ! excluding poles
     189            teta(i,j,l)=teta(i,j,l)
     190     &                  -rdamp(l)*(teta(i,j,l)-tzon(j,l))
     191          enddo
     192        enddo
     193       enddo
     194      endif ! of if (mode_top_bound.ge.3)
     195   
    142196      END

  • LMDZ5/branches/testing/libf/dyn3dmem/abort_gcm.F

    r1707 r1795  
    11!
    2 ! $Id$
     2! $Id: abort_gcm.F 1747 2013-04-23 14:06:30Z lguez $
    33!
    44c
    … …  
    2424
    2525      character(len=*) modname
    26       integer ierr
     26      integer ierr, ierror_mpi
    2727      character(len=*) message
    2828
    … …  
    4747      else
    4848        write(lunout,*) 'Houston, we have a problem ', ierr
     49#ifdef CPP_MPI
     50C$OMP CRITICAL (MPI_ABORT_GCM)
     51        call MPI_ABORT(COMM_LMDZ, 1, ierror_mpi)
     52C$OMP END CRITICAL (MPI_ABORT_GCM)
     53#else
    4954        stop 1
     55#endif         
    5056      endif
    5157      END

  • LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F

    r1707 r1795  
    3434      USE dimphy
    3535      USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
    36       USE parallel, ONLY : omp_chunk, using_mpi,jjb_u,jje_u,jjb_v,jje_v
    3736      USE mod_interface_dyn_phys
    3837      USE IOPHY
    3938#endif
     39      USE parallel, ONLY : omp_chunk, using_mpi,jjb_u,jje_u,jjb_v,jje_v
    4040      USE Write_Field
    4141      Use Write_field_p
    … …  
    116116c    -----------
    117117      LOGICAL  lafin
    118       REAL heure
    119 
     118!      REAL heure
     119      REAL, intent(in):: jD_cur, jH_cur
    120120      REAL pvcov(iip1,jjb_v:jje_v,llm)
    121121      REAL pucov(iip1,jjb_u:jje_u,llm)
    … …  
    130130      REAL pdteta(iip1,jjb_u:jje_u,llm)
    131131      REAL pdq(iip1,jjb_u:jje_u,llm,nqtot)
     132      REAL flxw(iip1,jjb_u:jje_u,llm)  ! Flux de masse verticale sur la grille dynamique
    132133c
    133134      REAL pps(iip1,jjb_u:jje_u)
    … …  
    226227      REAL PVteta(klon,ntetaSTD)
    227228     
    228       REAL flxw(iip1,jjb_u:jje_u,llm)  ! Flux de masse verticale sur la grille dynamique
    229229     
    230230      REAL SSUM
    … …  
    234234      SAVE firstcal,debut
    235235c$OMP THREADPRIVATE(firstcal,debut)
    236       REAL, intent(in):: jD_cur, jH_cur
    237236     
    238237      REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv

  • LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90

    r1707 r1795  
    321321#endif
    322322
    323     IF (ok_strato) THEN
    324       CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    325     ENDIF
    326 
    327323#ifdef DEBUG_IO           
    328324    CALL WriteField_u('ucovfi',ucov)
    … …  
    348344    ENDDO
    349345#endif
     346
     347    IF (ok_strato) THEN
     348!      CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
     349      CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
     350    ENDIF
    350351
    351352  !$OMP BARRIER

  • LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90

    r1707 r1795  
    2323  USE infotrac
    2424  USE parallel, ONLY: finalize_parallel
     25  USE indice_sol_mod
    2526
    2627#ifdef CPP_IOIPSL
    … …  
    3940#include "dimensions.h"
    4041#include "paramet.h"
    41 #include "indicesol.h"
     42!#include "indicesol.h"
    4243#include "iniprint.h"
    4344#include "temps.h"

  • LMDZ5/branches/testing/libf/dyn3dmem/comconst.h

    r1707 r1795  
    11!
    2 ! $Id$
     2! $Id: comconst.h 1671 2012-10-24 07:10:10Z emillour $
    33!
    44!-----------------------------------------------------------------------
    … …  
    66
    77      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
    8      &                 iflag_top_bound
     8     &                 iflag_top_bound,mode_top_bound
    99      COMMON/comconstr/dtvr,daysec,                                     &
    1010     & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
    … …  
    2121      REAL dtdiss ! (s) time step for the dissipation
    2222      REAL rad ! (m) radius of the planet
    23       REAL r ! Reduced Gas constant r=R/mu 
    24              ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol) 
     23      REAL r ! Reduced Gas constant r=R/mu
     24             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
    2525      REAL cpp   ! Specific heat Cp (J.kg-1.K-1)
    2626      REAL kappa ! kappa=R/Cp
    … …  
    3030      REAL omeg ! (rad/s) rotation rate of the planet
    3131      REAL dissip_factz,dissip_deltaz,dissip_zref
    32       INTEGER iflag_top_bound
    33       REAL tau_top_bound
     32! top_bound sponge:
     33      INTEGER iflag_top_bound ! sponge type
     34      INTEGER mode_top_bound  ! sponge mode
     35      REAL tau_top_bound ! inverse of sponge characteristic time scale (Hz)
    3436      REAL daylen ! length of solar day, in 'standard' day length
    3537      REAL year_day ! Number of standard days in a year

  • LMDZ5/branches/testing/libf/dyn3dmem/comvert.h

    r1707 r1795  
    11!
    2 ! $Id$
     2! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $
    33!
    44!-----------------------------------------------------------------------
    … …  
    2323      real bps    ! hybrid sigma contribution at mid-layers
    2424      real scaleheight ! atmospheric (reference) scale height (km)
    25       real pseudoalt ! for planets
     25      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
     26                     ! preff and scaleheight
    2627
    2728      integer disvert_type ! type of vertical discretization:

  • LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F

    r1750 r1795  
    335335       CALL getin('dissip_zref',dissip_zref )
    336336
     337! top_bound sponge: only active if ok_strato=.true. and iflag_top_bound!=0
     338!                   iflag_top_bound=0 for no sponge
     339!                   iflag_top_bound=1 for sponge over 4 topmost layers
     340!                   iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
    337341       iflag_top_bound=1
     342       CALL getin('iflag_top_bound',iflag_top_bound)
     343
     344! mode_top_bound : fields towards which sponge relaxation will be done:
     345!                  mode_top_bound=0: no relaxation
     346!                  mode_top_bound=1: u and v relax towards 0
     347!                  mode_top_bound=2: u and v relax towards their zonal mean
     348!                  mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     349       mode_top_bound=3
     350       CALL getin('mode_top_bound',mode_top_bound)
     351
     352! top_bound sponge : inverse of charactericstic relaxation time scale for sponge
    338353       tau_top_bound=1.e-5
    339        CALL getin('iflag_top_bound',iflag_top_bound)
    340354       CALL getin('tau_top_bound',tau_top_bound)
    341355

  • LMDZ5/branches/testing/libf/dyn3dmem/exner_milieu_loc.F

    r1707 r1795  
    2727c
    2828      USE parallel
     29      USE mod_filtreg_p
    2930      IMPLICIT NONE
    3031c
    … …  
    120121        jjb=jj_begin
    121122        jje=jj_end
    122         CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
     123        CALL filtreg_p ( pkf,jjb_u,jje_u,jjb,jje, jmp1, llm,
     124     &                 2, 1, .TRUE., 1 )
    123125
    124126        ! our work is done, exit routine
    … …  
    206208      jjb=jj_begin
    207209      jje=jj_end
    208       CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
     210      CALL filtreg_p ( pkf,jjb_u,jje_u,jjb,jje, jmp1, llm,
     211     &                 2, 1, .TRUE., 1 )
    209212     
    210213c    EST-CE UTILE ?? : calcul de beta

  • LMDZ5/branches/testing/libf/dyn3dmem/gcm.F

    r1707 r1795  
    1919      USE filtreg_mod
    2020      USE control_mod
     21
     22#ifdef INCA
     23! Only INCA needs these informations (from the Earth's physics)
     24      USE indice_sol_mod
     25#endif
    2126
    2227#ifdef CPP_PHYS
    … …  
    7580#ifdef INCA
    7681! Only INCA needs these informations (from the Earth's physics)
    77 #include "indicesol.h"
     82!#include "indicesol.h"
    7883#endif
    7984
    … …  
    270275      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
    271276        if (iflag_phys.ne.1) then
    272           CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     277          CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
    273278        endif
    274279
    … …  
    291296     .              'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    292297      if (.not.read_start) then
    293          CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     298         CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
    294299      endif
    295300
    … …  
    398403#endif
    399404
    400 
     405      if (iflag_phys.eq.1) then
     406      ! these initialisations have already been done (via iniacademic)
     407      ! if running in SW or Newtonian mode
    401408c-----------------------------------------------------------------------
    402409c   Initialisation des constantes dynamiques :
    … …  
    414421c   --------------------------
    415422        CALL inifilr
     423      endif ! of if (iflag_phys.eq.1)
    416424c
    417425c-----------------------------------------------------------------------

  • LMDZ5/branches/testing/libf/dyn3dmem/inigeom.F

    r1669 r1795  
    426426         radclatm = 0.5* rad * coslatm
    427427c
     428         ai14            = un4rad2 * coslatp * yprp
     429         ai23            = un4rad2 * coslatm * yprm
    428430         DO 32 i = 1,iim
    429431         xprp            = xprimp025( i )
    430432         xprm            = xprimm025( i )
    431433     
    432          ai14            = un4rad2 * coslatp * yprp
    433          ai23            = un4rad2 * coslatm * yprm
    434434         aireij1 ( i,j ) = ai14 * xprp
    435435         aireij2 ( i,j ) = ai23 * xprp

  • LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F

    r1707 r1795  
    11251125        ! Sponge layer (if any)
    11261126        IF (ok_strato) THEN
    1127           ! set dufi,dvfi,... to zero
    1128           ijb=ij_begin
    1129           ije=ij_end
    1130 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1131           do l=1,llm
    1132             dufi(ijb:ije,l)=0
    1133             dtetafi(ijb:ije,l)=0
    1134             dqfi(ijb:ije,l,1:nqtot)=0
    1135           enddo
    1136 !$OMP END DO
    1137 !$OMP MASTER
    1138           dpfi(ijb:ije)=0
    1139 !$OMP END MASTER
    1140           ijb=ij_begin
    1141           ije=ij_end
    1142           if (pole_sud) ije=ije-iip1
    1143 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1144           do l=1,llm
    1145             dvfi(ijb:ije,l)=0
    1146           enddo
    1147 !$OMP END DO
    1148 
    1149           CALL top_bound_loc(vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    1150           CALL addfi_loc( dtvr, leapf, forward   ,
    1151      $                  ucov, vcov, teta , q   ,ps ,
    1152      $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
     1127          CALL top_bound_loc(vcov,ucov,teta,masse,dtvr)
    11531128!$OMP BARRIER
    11541129        ENDIF ! of IF (ok_strato)

  • LMDZ5/branches/testing/libf/dyn3dmem/temps.h

    r1707 r1795  
    1313! INCLUDE 'temps.h'
    1414
    15       COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
    16      &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
    17      &             start_time
     15      COMMON/temps/ dt, jD_ref, jH_ref, start_time,                     &
     16     &             day_ini, day_end, annee_ref, day_ref,                &
     17     &             itau_dyn, itau_phy, itaufin, calend
    1818
    1919
    2020      INTEGER   itaufin
    21       INTEGER itau_dyn, itau_phy
     21      INTEGER itau_dyn, itau_phy 
    2222      INTEGER day_ini, day_end, annee_ref, day_ref
    2323      REAL      dt, jD_ref, jH_ref, start_time

  • LMDZ5/branches/testing/libf/dyn3dmem/top_bound_loc.F

    r1669 r1795  
    1       SUBROUTINE top_bound_loc( vcov,ucov,teta,masse, du,dv,dh )
     1!
     2! $Id: $
     3!
     4      SUBROUTINE top_bound_loc(vcov,ucov,teta,masse,dt)
    25      USE parallel
    36      IMPLICIT NONE
    … …  
    2528c
    2629c=======================================================================
    27 c-----------------------------------------------------------------------
    28 c   Declarations:
    29 c   -------------
     30
     31! top_bound sponge layer model:
     32! Quenching is modeled as: A(t)=Am+A0*exp(-lambda*t)
     33! where Am is the zonal average of the field (or zero), and lambda the inverse
     34! of the characteristic quenching/relaxation time scale
     35! Thus, assuming Am to be time-independent, field at time t+dt is given by:
     36! A(t+dt)=A(t)-(A(t)-Am)*(1-exp(-lambda*t))
     37! Moreover lambda can be a function of model level (see below), and relaxation
     38! can be toward the average zonal field or just zero (see below).
     39
     40! NB: top_bound sponge is only called from leapfrog if ok_strato=.true.
     41
     42! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst.h)
     43!    iflag_top_bound=0 for no sponge
     44!    iflag_top_bound=1 for sponge over 4 topmost layers
     45!    iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
     46!    mode_top_bound=0: no relaxation
     47!    mode_top_bound=1: u and v relax towards 0
     48!    mode_top_bound=2: u and v relax towards their zonal mean
     49!    mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     50!    tau_top_bound : inverse of charactericstic relaxation time scale at
     51!                       the topmost layer (Hz)
     52
    3053
    3154#include "comdissipn.h"
     55#include "iniprint.h"
    3256
    3357c   Arguments:
    3458c   ----------
    3559
    36       REAL ucov(iip1,jjb_u:jje_u,llm),vcov(iip1,jjb_v:jje_v,llm)
    37       REAL teta(iip1,jjb_u:jje_u,llm)
    38       REAL masse(iip1,jjb_u:jje_u,llm)
    39       REAL dv(iip1,jjb_v:jje_v,llm),du(iip1,jjb_u:jje_u,llm)
    40       REAL dh(iip1,jjb_u:jje_u,llm)
     60      real,intent(inout) :: ucov(iip1,jjb_u:jje_u,llm) ! covariant zonal wind
     61      real,intent(inout) :: vcov(iip1,jjb_v:jje_v,llm) ! covariant meridional wind
     62      real,intent(inout) :: teta(iip1,jjb_u:jje_u,llm) ! potential temperature
     63      real,intent(in) :: masse(iip1,jjb_u:jje_u,llm) ! mass of atmosphere
     64      real,intent(in) :: dt ! time step (s) of sponge model
     65
     66!      REAL dv(iip1,jjb_v:jje_v,llm),du(iip1,jjb_u:jje_u,llm)
     67!      REAL dh(iip1,jjb_u:jje_u,llm)
    4168
    4269c   Local:
    … …  
    4774      REAL tzon(jjb_u:jje_u,llm)
    4875     
    49       INTEGER NDAMP
    50       PARAMETER (NDAMP=4)
    5176      integer i
    5277      REAL,SAVE :: rdamp(llm)
    53 !     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     78      real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
    5479      LOGICAL,SAVE :: first=.true.
    5580      INTEGER j,l,jjb,jje
    … …  
    5782
    5883      if (iflag_top_bound == 0) return
     84
    5985      if (first) then
    6086c$OMP BARRIER
    6187c$OMP MASTER
    6288         if (iflag_top_bound == 1) then
    63 ! couche eponge dans les 4 dernieres couches du modele
    64              rdamp(:)=0.
    65              rdamp(llm)=tau_top_bound
    66              rdamp(llm-1)=tau_top_bound/2.
    67              rdamp(llm-2)=tau_top_bound/4.
    68              rdamp(llm-3)=tau_top_bound/8.
     89! sponge quenching over the topmost 4 atmospheric layers
     90             lambda(:)=0.
     91             lambda(llm)=tau_top_bound
     92             lambda(llm-1)=tau_top_bound/2.
     93             lambda(llm-2)=tau_top_bound/4.
     94             lambda(llm-3)=tau_top_bound/8.
    6995         else if (iflag_top_bound == 2) then
    70 ! couce eponge dans toutes les couches de pression plus faible que
    71 ! 100 fois la pression de la derniere couche
    72              rdamp(:)=tau_top_bound
     96! sponge quenching over topmost layers down to pressures which are
     97! higher than 100 times the topmost layer pressure
     98             lambda(:)=tau_top_bound
    7399     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
    74100         endif
     101
     102! quenching coefficient rdamp(:)
     103!         rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
     104         rdamp(:)=1.-exp(-lambda(:)*dt)
     105
     106         write(lunout,*)'TOP_BOUND mode',mode_top_bound
     107         write(lunout,*)'Sponge layer coefficients'
     108         write(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
     109         do l=1,llm
     110           if (rdamp(l).ne.0.) then
     111             write(lunout,'(6(1pe12.4,1x))')
     112     &        presnivs(l),log(preff/presnivs(l))*scaleheight,
     113     &           1./lambda(l),lambda(l)
     114           endif
     115         enddo
    75116         first=.false.
    76          print*,'TOP_BOUND rdamp=',rdamp
    77117c$OMP END MASTER
    78118c$OMP BARRIER
    79       endif
     119      endif ! of if (first)
    80120
    81121
    82122      CALL massbar_loc(masse,massebx,masseby)
    83 C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    84 
    85       jjb=jj_begin
    86       jje=jj_end
    87       IF (pole_sud) jje=jj_end-1
    88 
    89 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    90       do l=1,llm
     123
     124      ! compute zonal average of vcov (or set it to zero)
     125      if (mode_top_bound.ge.2) then
     126       jjb=jj_begin
     127       jje=jj_end
     128       IF (pole_sud) jje=jj_end-1
     129c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     130       do l=1,llm
    91131        do j=jjb,jje
    92132          zm=0.
    93133          vzon(j,l)=0
    94134          do i=1,iim
    95 ! Rm: on peut travailler directement avec la moyenne zonale de vcov
    96 ! plutot qu'avec celle de v car le coefficient cv qui relie les deux
    97 ! ne varie qu'en latitude
     135! NB: we can work using vcov zonal mean rather than v since the
     136! cv coefficient (which relates the two) only varies with latitudes
    98137            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
    99138            zm=zm+masseby(i,j,l)
    … …  
    101140          vzon(j,l)=vzon(j,l)/zm
    102141        enddo
    103       enddo
     142       enddo
    104143c$OMP END DO NOWAIT   
    105 
    106 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    107       do l=1,llm
    108         do j=jjb,jje
    109           do i=1,iip1
    110             dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
    111           enddo
    112         enddo
    113       enddo
    114 c$OMP END DO NOWAIT
    115 
    116       jjb=jj_begin
    117       jje=jj_end
    118       IF (pole_nord) jjb=jj_begin+1
    119       IF (pole_sud)  jje=jj_end-1
    120 
    121 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    122       do l=1,llm
     144      else
     145c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     146       do l=1,llm
     147         vzon(:,l)=0.
     148       enddo
     149c$OMP END DO NOWAIT
     150      endif ! of if (mode_top_bound.ge.2)
     151
     152      ! compute zonal average of u (or set it to zero)
     153      if (mode_top_bound.ge.2) then
     154       jjb=jj_begin
     155       jje=jj_end
     156       IF (pole_nord) jjb=jj_begin+1
     157       IF (pole_sud)  jje=jj_end-1
     158c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     159       do l=1,llm
    123160        do j=jjb,jje
    124161          uzon(j,l)=0.
    … …  
    130167          uzon(j,l)=uzon(j,l)/zm
    131168        enddo
    132       enddo
    133 c$OMP END DO NOWAIT
    134 
     169       enddo
     170c$OMP END DO NOWAIT
     171      else
     172c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     173       do l=1,llm
     174         uzon(:,l)=0.
     175       enddo
     176c$OMP END DO NOWAIT
     177      endif ! of if (mode_top_bound.ge.2)
     178
     179      ! compute zonal average of potential temperature, if necessary
     180      if (mode_top_bound.ge.3) then
     181       jjb=jj_begin
     182       jje=jj_end
     183       IF (pole_nord) jjb=jj_begin+1
     184       IF (pole_sud)  jje=jj_end-1
    135185c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    136       do l=1,llm
     186       do l=1,llm
    137187        do j=jjb,jje
    138188          zm=0.
    … …  
    144194          tzon(j,l)=tzon(j,l)/zm
    145195        enddo
    146       enddo
    147 c$OMP END DO NOWAIT
    148 
    149 C   AMORTISSEMENTS LINEAIRES:
    150 
    151 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    152       do l=1,llm
     196       enddo
     197c$OMP END DO NOWAIT
     198      endif ! of if (mode_top_bound.ge.3)
     199
     200      if (mode_top_bound.ge.1) then
     201       ! Apply sponge quenching on vcov:
     202       jjb=jj_begin
     203       jje=jj_end
     204       IF (pole_sud) jje=jj_end-1
     205
     206c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     207       do l=1,llm
    153208        do j=jjb,jje
    154209          do i=1,iip1
    155             du(i,j,l)=du(i,j,l)
    156      s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
    157             dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
    158           enddo
    159        enddo
    160       enddo
    161 c$OMP END DO NOWAIT
    162      
    163 
    164       RETURN
     210            vcov(i,j,l)=vcov(i,j,l)
     211     &                  -rdamp(l)*(vcov(i,j,l)-vzon(j,l))
     212          enddo
     213        enddo
     214       enddo
     215c$OMP END DO NOWAIT
     216
     217       ! Apply sponge quenching on ucov:
     218       jjb=jj_begin
     219       jje=jj_end
     220       IF (pole_nord) jjb=jj_begin+1
     221       IF (pole_sud)  jje=jj_end-1
     222
     223c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     224       do l=1,llm
     225        do j=jjb,jje
     226          do i=1,iip1
     227            ucov(i,j,l)=ucov(i,j,l)
     228     &                  -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
     229          enddo
     230       enddo
     231       enddo
     232c$OMP END DO NOWAIT
     233      endif ! of if (mode_top_bound.ge.1)
     234
     235      if (mode_top_bound.ge.3) then   
     236       ! Apply sponge quenching on teta:
     237       jjb=jj_begin
     238       jje=jj_end
     239       IF (pole_nord) jjb=jj_begin+1
     240       IF (pole_sud)  jje=jj_end-1
     241
     242c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     243       do l=1,llm
     244        do j=jjb,jje
     245          do i=1,iip1
     246            teta(i,j,l)=teta(i,j,l)
     247     &                  -rdamp(l)*(teta(i,j,l)-tzon(j,l))
     248          enddo
     249       enddo
     250       enddo
     251c$OMP END DO NOWAIT
     252      endif ! of if (mode_top_bond.ge.3)
     253
    165254      END

  • LMDZ5/branches/testing/libf/dyn3dpar/abort_gcm.F

    r1492 r1795  
    2424
    2525      character(len=*) modname
    26       integer ierr
     26      integer ierr, ierror_mpi
    2727      character(len=*) message
    2828
    … …  
    4747      else
    4848        write(lunout,*) 'Houston, we have a problem ', ierr
     49#ifdef CPP_MPI
     50C$OMP CRITICAL (MPI_ABORT_GCM)
     51        call MPI_ABORT(COMM_LMDZ, 1, ierror_mpi)
     52C$OMP END CRITICAL (MPI_ABORT_GCM)
     53#else
    4954        stop 1
     55#endif         
    5056      endif
    5157      END

  • LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90

    r1665 r1795  
    2323  USE infotrac
    2424  USE parallel, ONLY: finalize_parallel
     25  USE indice_sol_mod
    2526
    2627#ifdef CPP_IOIPSL
    … …  
    3940#include "dimensions.h"
    4041#include "paramet.h"
    41 #include "indicesol.h"
     42!#include "indicesol.h"
    4243#include "iniprint.h"
    4344#include "temps.h"

  • LMDZ5/branches/testing/libf/dyn3dpar/comconst.h

    r1707 r1795  
    66
    77      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
    8      &                 iflag_top_bound
     8     &                 iflag_top_bound,mode_top_bound
    99      COMMON/comconstr/dtvr,daysec,                                     &
    1010     & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
    … …  
    3030      REAL omeg ! (rad/s) rotation rate of the planet
    3131      REAL dissip_factz,dissip_deltaz,dissip_zref
    32       INTEGER iflag_top_bound
    33       REAL tau_top_bound
     32! top_bound sponge:
     33      INTEGER iflag_top_bound ! sponge type
     34      INTEGER mode_top_bound  ! sponge mode
     35      REAL tau_top_bound ! inverse of sponge characteristic time scale (Hz)
    3436      REAL daylen ! length of solar day, in 'standard' day length
    3537      REAL year_day ! Number of standard days in a year

  • LMDZ5/branches/testing/libf/dyn3dpar/comvert.h

    r1669 r1795  
    2323      real bps    ! hybrid sigma contribution at mid-layers
    2424      real scaleheight ! atmospheric (reference) scale height (km)
    25       real pseudoalt ! for planets
     25      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
     26                     ! preff and scaleheight
    2627
    2728      integer disvert_type ! type of vertical discretization:

  • LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F

    r1750 r1795  
    334334       CALL getin('dissip_zref',dissip_zref )
    335335
     336! top_bound sponge: only active if ok_strato=.true. and iflag_top_bound!=0
     337!                   iflag_top_bound=0 for no sponge
     338!                   iflag_top_bound=1 for sponge over 4 topmost layers
     339!                   iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
    336340       iflag_top_bound=1
     341       CALL getin('iflag_top_bound',iflag_top_bound)
     342
     343! mode_top_bound : fields towards which sponge relaxation will be done:
     344!                  mode_top_bound=0: no relaxation
     345!                  mode_top_bound=1: u and v relax towards 0
     346!                  mode_top_bound=2: u and v relax towards their zonal mean
     347!                  mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     348       mode_top_bound=3
     349       CALL getin('mode_top_bound',mode_top_bound)
     350
     351! top_bound sponge : inverse of charactericstic relaxation time scale for sponge
    337352       tau_top_bound=1.e-5
    338        CALL getin('iflag_top_bound',iflag_top_bound)
    339353       CALL getin('tau_top_bound',tau_top_bound)
    340354

  • LMDZ5/branches/testing/libf/dyn3dpar/gcm.F

    r1707 r1795  
    1919      USE filtreg_mod
    2020      USE control_mod
     21
     22#ifdef INCA
     23! Only INCA needs these informations (from the Earth's physics)
     24      USE indice_sol_mod
     25#endif
    2126
    2227#ifdef CPP_PHYS
    … …  
    7580#ifdef INCA
    7681! Only INCA needs these informations (from the Earth's physics)
    77 #include "indicesol.h"
     82!#include "indicesol.h"
    7883#endif
    7984

  • LMDZ5/branches/testing/libf/dyn3dpar/inigeom.F

    r1403 r1795  
    426426         radclatm = 0.5* rad * coslatm
    427427c
     428         ai14            = un4rad2 * coslatp * yprp
     429         ai23            = un4rad2 * coslatm * yprm
    428430         DO 32 i = 1,iim
    429431         xprp            = xprimp025( i )
    430432         xprm            = xprimm025( i )
    431433     
    432          ai14            = un4rad2 * coslatp * yprp
    433          ai23            = un4rad2 * coslatm * yprm
    434434         aireij1 ( i,j ) = ai14 * xprp
    435435         aireij2 ( i,j ) = ai23 * xprp

  • LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F

    r1707 r1795  
    904904c      ajout des tendances physiques:
    905905c      ------------------------------
    906          IF (ok_strato) THEN
    907            CALL top_bound_p( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    908          ENDIF
    909        
    910906          CALL addfi_p( dtphys, leapf, forward   ,
    911907     $                  ucov, vcov, teta , q   ,ps ,
    912908     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    913909
     910         IF (ok_strato) THEN
     911           CALL top_bound_p(vcov,ucov,teta,masse,dtphys)
     912         ENDIF
     913       
    914914c$OMP BARRIER
    915915c$OMP MASTER
    … …  
    10241024        ! Sponge layer (if any)
    10251025        IF (ok_strato) THEN
    1026           ! set dufi,dvfi,... to zero
    1027           ijb=ij_begin
    1028           ije=ij_end
    1029 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1030           do l=1,llm
    1031             dufi(ijb:ije,l)=0
    1032             dtetafi(ijb:ije,l)=0
    1033             dqfi(ijb:ije,l,1:nqtot)=0
    1034           enddo
    1035 !$OMP END DO
    1036 !$OMP MASTER
    1037           dpfi(ijb:ije)=0
    1038 !$OMP END MASTER
    1039           ijb=ij_begin
    1040           ije=ij_end
    1041           if (pole_sud) ije=ije-iip1
    1042 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1043           do l=1,llm
    1044             dvfi(ijb:ije,l)=0
    1045           enddo
    1046 !$OMP END DO
    1047 
    1048           CALL top_bound_p(vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    1049           CALL addfi_p( dtvr, leapf, forward   ,
    1050      $                  ucov, vcov, teta , q   ,ps ,
    1051      $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
     1026          CALL top_bound_p(vcov,ucov,teta,masse,dtvr)
    10521027!$OMP BARRIER
    10531028        ENDIF ! of IF (ok_strato)

  • LMDZ5/branches/testing/libf/dyn3dpar/temps.h

    r1665 r1795  
    1313! INCLUDE 'temps.h'
    1414
    15       COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
    16      &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
    17      &             start_time
     15      COMMON/temps/ dt, jD_ref, jH_ref, start_time,                     &
     16     &             day_ini, day_end, annee_ref, day_ref,                &
     17     &             itau_dyn, itau_phy, itaufin, calend
    1818
    1919
    2020      INTEGER   itaufin
    21       INTEGER itau_dyn, itau_phy
     21      INTEGER itau_dyn, itau_phy 
    2222      INTEGER day_ini, day_end, annee_ref, day_ref
    2323      REAL      dt, jD_ref, jH_ref, start_time

  • LMDZ5/branches/testing/libf/dyn3dpar/top_bound_p.F

    r1279 r1795  
    1       SUBROUTINE top_bound_p( vcov,ucov,teta,masse, du,dv,dh )
     1!
     2! $Id$
     3!
     4      SUBROUTINE top_bound_p(vcov,ucov,teta,masse,dt)
    25      USE parallel
    36      IMPLICIT NONE
    … …  
    2528c
    2629c=======================================================================
    27 c-----------------------------------------------------------------------
    28 c   Declarations:
    29 c   -------------
     30
     31! top_bound sponge layer model:
     32! Quenching is modeled as: A(t)=Am+A0*exp(-lambda*t)
     33! where Am is the zonal average of the field (or zero), and lambda the inverse
     34! of the characteristic quenching/relaxation time scale
     35! Thus, assuming Am to be time-independent, field at time t+dt is given by:
     36! A(t+dt)=A(t)-(A(t)-Am)*(1-exp(-lambda*t))
     37! Moreover lambda can be a function of model level (see below), and relaxation
     38! can be toward the average zonal field or just zero (see below).
     39
     40! NB: top_bound sponge is only called from leapfrog if ok_strato=.true.
     41
     42! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst.h)
     43!    iflag_top_bound=0 for no sponge
     44!    iflag_top_bound=1 for sponge over 4 topmost layers
     45!    iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
     46!    mode_top_bound=0: no relaxation
     47!    mode_top_bound=1: u and v relax towards 0
     48!    mode_top_bound=2: u and v relax towards their zonal mean
     49!    mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
     50!    tau_top_bound : inverse of charactericstic relaxation time scale at
     51!                       the topmost layer (Hz)
     52
    3053
    3154#include "comdissipn.h"
     55#include "iniprint.h"
    3256
    3357c   Arguments:
    3458c   ----------
    3559
    36       REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
    37       REAL masse(iip1,jjp1,llm)
    38       REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
     60      real,intent(inout) :: ucov(iip1,jjp1,llm) ! covariant zonal wind
     61      real,intent(inout) :: vcov(iip1,jjm,llm) ! covariant meridional wind
     62      real,intent(inout) :: teta(iip1,jjp1,llm) ! potential temperature
     63      real,intent(in) :: masse(iip1,jjp1,llm) ! mass of atmosphere
     64      real,intent(in) :: dt ! time step (s) of sponge model
    3965
    4066c   Local:
    … …  
    4369      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
    4470     
    45       INTEGER NDAMP
    46       PARAMETER (NDAMP=4)
    4771      integer i
    48       REAL,SAVE :: rdamp(llm)
    49 !     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     72      REAL,SAVE :: rdamp(llm) ! quenching coefficient
     73      real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
    5074      LOGICAL,SAVE :: first=.true.
    5175      INTEGER j,l,jjb,jje
    … …  
    5377
    5478      if (iflag_top_bound == 0) return
     79
    5580      if (first) then
    5681c$OMP BARRIER
    5782c$OMP MASTER
    5883         if (iflag_top_bound == 1) then
    59 ! couche eponge dans les 4 dernieres couches du modele
    60              rdamp(:)=0.
    61              rdamp(llm)=tau_top_bound
    62              rdamp(llm-1)=tau_top_bound/2.
    63              rdamp(llm-2)=tau_top_bound/4.
    64              rdamp(llm-3)=tau_top_bound/8.
     84! sponge quenching over the topmost 4 atmospheric layers
     85             lambda(:)=0.
     86             lambda(llm)=tau_top_bound
     87             lambda(llm-1)=tau_top_bound/2.
     88             lambda(llm-2)=tau_top_bound/4.
     89             lambda(llm-3)=tau_top_bound/8.
    6590         else if (iflag_top_bound == 2) then
    66 ! couce eponge dans toutes les couches de pression plus faible que
    67 ! 100 fois la pression de la derniere couche
    68              rdamp(:)=tau_top_bound
     91! sponge quenching over topmost layers down to pressures which are
     92! higher than 100 times the topmost layer pressure
     93             lambda(:)=tau_top_bound
    6994     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
    7095         endif
     96
     97! quenching coefficient rdamp(:)
     98!         rdamp(:)=dt*lambda(:) ! Explicit Euler approx.
     99         rdamp(:)=1.-exp(-lambda(:)*dt)
     100
     101         write(lunout,*)'TOP_BOUND mode',mode_top_bound
     102         write(lunout,*)'Sponge layer coefficients'
     103         write(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
     104         do l=1,llm
     105           if (rdamp(l).ne.0.) then
     106             write(lunout,'(6(1pe12.4,1x))')
     107     &        presnivs(l),log(preff/presnivs(l))*scaleheight,
     108     &           1./lambda(l),lambda(l)
     109           endif
     110         enddo
    71111         first=.false.
    72          print*,'TOP_BOUND rdamp=',rdamp
    73112c$OMP END MASTER
    74113c$OMP BARRIER
    75       endif
     114      endif ! of if (first)
    76115
    77116
    78117      CALL massbar_p(masse,massebx,masseby)
    79 C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    80 
    81       jjb=jj_begin
    82       jje=jj_end
    83       IF (pole_sud) jje=jj_end-1
    84 
    85 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    86       do l=1,llm
     118
     119      ! compute zonal average of vcov (or set it to zero)
     120      if (mode_top_bound.ge.2) then
     121       jjb=jj_begin
     122       jje=jj_end
     123       IF (pole_sud) jje=jj_end-1
     124c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     125       do l=1,llm
    87126        do j=jjb,jje
    88127          zm=0.
    89128          vzon(j,l)=0
    90129          do i=1,iim
    91 ! Rm: on peut travailler directement avec la moyenne zonale de vcov
    92 ! plutot qu'avec celle de v car le coefficient cv qui relie les deux
    93 ! ne varie qu'en latitude
     130! NB: we can work using vcov zonal mean rather than v since the
     131! cv coefficient (which relates the two) only varies with latitudes
    94132            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
    95133            zm=zm+masseby(i,j,l)
    … …  
    97135          vzon(j,l)=vzon(j,l)/zm
    98136        enddo
    99       enddo
     137       enddo
    100138c$OMP END DO NOWAIT   
    101 
    102 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    103       do l=1,llm
    104         do j=jjb,jje
    105           do i=1,iip1
    106             dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
    107           enddo
    108         enddo
    109       enddo
    110 c$OMP END DO NOWAIT
    111 
    112       jjb=jj_begin
    113       jje=jj_end
    114       IF (pole_nord) jjb=jj_begin+1
    115       IF (pole_sud)  jje=jj_end-1
    116 
    117 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    118       do l=1,llm
     139      else
     140c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     141       do l=1,llm
     142         vzon(:,l)=0.
     143       enddo
     144c$OMP END DO NOWAIT
     145      endif ! of if (mode_top_bound.ge.2)
     146
     147      ! compute zonal average of u (or set it to zero)
     148      if (mode_top_bound.ge.2) then
     149       jjb=jj_begin
     150       jje=jj_end
     151       IF (pole_nord) jjb=jj_begin+1
     152       IF (pole_sud)  jje=jj_end-1
     153c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     154       do l=1,llm
    119155        do j=jjb,jje
    120156          uzon(j,l)=0.
    … …  
    126162          uzon(j,l)=uzon(j,l)/zm
    127163        enddo
    128       enddo
    129 c$OMP END DO NOWAIT
    130 
     164       enddo
     165c$OMP END DO NOWAIT
     166      else
     167c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     168       do l=1,llm
     169         uzon(:,l)=0.
     170       enddo
     171c$OMP END DO NOWAIT
     172      endif ! of if (mode_top_bound.ge.2)
     173
     174      ! compute zonal average of potential temperature, if necessary
     175      if (mode_top_bound.ge.3) then
     176       jjb=jj_begin
     177       jje=jj_end
     178       IF (pole_nord) jjb=jj_begin+1
     179       IF (pole_sud)  jje=jj_end-1
    131180c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    132       do l=1,llm
     181       do l=1,llm
    133182        do j=jjb,jje
    134183          zm=0.
    … …  
    140189          tzon(j,l)=tzon(j,l)/zm
    141190        enddo
    142       enddo
    143 c$OMP END DO NOWAIT
    144 
    145 C   AMORTISSEMENTS LINEAIRES:
    146 
    147 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    148       do l=1,llm
     191       enddo
     192c$OMP END DO NOWAIT
     193      endif ! of if (mode_top_bound.ge.3)
     194
     195      if (mode_top_bound.ge.1) then
     196       ! Apply sponge quenching on vcov:
     197       jjb=jj_begin
     198       jje=jj_end
     199       IF (pole_sud) jje=jj_end-1
     200
     201c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     202       do l=1,llm
    149203        do j=jjb,jje
    150204          do i=1,iip1
    151             du(i,j,l)=du(i,j,l)
    152      s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
    153             dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
    154           enddo
    155        enddo
    156       enddo
    157 c$OMP END DO NOWAIT
    158      
    159 
    160       RETURN
     205            vcov(i,j,l)=vcov(i,j,l)
     206     &                  -rdamp(l)*(vcov(i,j,l)-vzon(j,l))
     207          enddo
     208        enddo
     209       enddo
     210c$OMP END DO NOWAIT
     211
     212       ! Apply sponge quenching on ucov:
     213       jjb=jj_begin
     214       jje=jj_end
     215       IF (pole_nord) jjb=jj_begin+1
     216       IF (pole_sud)  jje=jj_end-1
     217
     218c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     219       do l=1,llm
     220        do j=jjb,jje
     221          do i=1,iip1
     222            ucov(i,j,l)=ucov(i,j,l)
     223     &                  -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
     224          enddo
     225       enddo
     226       enddo
     227c$OMP END DO NOWAIT
     228      endif ! of if (mode_top_bound.ge.1)
     229
     230      if (mode_top_bound.ge.3) then   
     231       ! Apply sponge quenching on teta:
     232       jjb=jj_begin
     233       jje=jj_end
     234       IF (pole_nord) jjb=jj_begin+1
     235       IF (pole_sud)  jje=jj_end-1
     236
     237c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     238       do l=1,llm
     239        do j=jjb,jje
     240          do i=1,iip1
     241            teta(i,j,l)=teta(i,j,l)
     242     &                  -rdamp(l)*(teta(i,j,l)-tzon(j,l))
     243          enddo
     244       enddo
     245       enddo
     246c$OMP END DO NOWAIT
     247      endif ! of if (mode_top_bond.ge.3)
     248
    161249      END

  • LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_no_writelim

    r1707 r1795  
    2727#include "compar1d.h"
    2828#include "flux_arp.h"
     29#include "tsoilnudge.h"
    2930#include "fcg_gcssold.h"
    3031#include "fcg_racmo.h"
    … …  
    100101!             initial profiles from RICO idealized
    101102!             LS convergence imposed from  RICO (cst)
     103!         = 6 ==> forcing_amma = .true.
    102104!         = 40 ==> forcing_GCSSold = .true.
    103105!             initial profile from GCSS file
    104106!             LS convergence imposed from GCSS file
     107!         = 59 ==> forcing_sandu = .true.
     108!             initial profiles from sanduref file: see prof.inp.001
     109!             SST varying with time and divergence constante: see ifa_sanduref.txt file
     110!             Radiation has to be computed interactively
     111!         = 60 ==> forcing_astex = .true.
     112!             initial profiles from file: see prof.inp.001
     113!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
     114!             Radiation has to be computed interactively
     115!         = 61 ==> forcing_armcu = .true.
     116!             initial profiles from file: see prof.inp.001
     117!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
     118!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
     119!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s
     120!             Radiation to be switched off
    105121!
    106122       forcing_type = 0
    … …  
    126142       CALL getin('ok_flux_surf',ok_flux_surf)
    127143
     144!Config  Key  = ok_old_disvert
     145!Config  Desc = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
     146!Config  Def  = false
     147!Config  Help = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
     148       ok_old_disvert = .FALSE.
     149       CALL getin('ok_old_disvert',ok_old_disvert)
     150
    128151!Config  Key  = time_ini
    129152!Config  Desc = meaningless in this  case
    … …  
    227250       zpicinp = 300.
    228251       CALL getin('zpicinp',zpicinp)
     252!Config key = nudge_tsoil
     253!Config  Desc = activation of soil temperature nudging
     254!Config  Def  = .FALSE.
     255!Config  Help = ...
     256
     257       nudge_tsoil=.FALSE.
     258       CALL getin('nudge_tsoil',nudge_tsoil)
     259
     260!Config key = isoil_nudge
     261!Config  Desc = level number where soil temperature is nudged
     262!Config  Def  = 3
     263!Config  Help = ...
     264
     265       isoil_nudge=3
     266       CALL getin('isoil_nudge',isoil_nudge)
     267
     268!Config key = Tsoil_nudge
     269!Config  Desc = target temperature for tsoil(isoil_nudge)
     270!Config  Def  = 300.
     271!Config  Help = ...
     272
     273       Tsoil_nudge=300.
     274       CALL getin('Tsoil_nudge',Tsoil_nudge)
     275
     276!Config key = tau_soil_nudge
     277!Config  Desc = nudging relaxation time for tsoil
     278!Config  Def  = 3600.
     279!Config  Help = ...
     280
     281       tau_soil_nudge=3600.
     282       CALL getin('tau_soil_nudge',tau_soil_nudge)
     283
     284
    229285
    230286
    … …  
    250306      write(lunout,*)' qsolinp = ', qsolinp
    251307      write(lunout,*)' zpicinp = ', zpicinp
     308      write(lunout,*)' nudge_tsoil = ', nudge_tsoil
     309      write(lunout,*)' isoil_nudge = ', isoil_nudge
     310      write(lunout,*)' Tsoil_nudge = ', Tsoil_nudge
     311      write(lunout,*)' tau_soil_nudge = ', tau_soil_nudge
    252312      IF (forcing_type .eq.40) THEN
    253313        write(lunout,*) '--- Forcing type GCSS Old --- with:'
    … …  
    703763      RETURN
    704764      END
    705       subroutine scopy(n,sx,incx,sy,incy)
    706 !
    707       IMPLICIT NONE
    708 !
    709       integer n,incx,incy,ix,iy,i
    710       real sx((n-1)*incx+1),sy((n-1)*incy+1)
    711 !
    712       iy=1
    713       ix=1
    714       do 10 i=1,n
    715          sy(iy)=sx(ix)
    716          ix=ix+incx
    717          iy=iy+incy
    718 10    continue
    719 !
    720       return
    721       end
    722765      subroutine wrgradsfi(if,nl,field,name,titlevar)
    723766      implicit none
    … …  
    956999      END
    9571000 
    958       SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
    959  
     1001      SUBROUTINE disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
     1002 
     1003!    Ancienne version disvert dont on a modifie nom pour utiliser
     1004!    le disvert de dyn3d (qui permet d'utiliser grille avec ab,bp imposes)
     1005!    (MPL 18092012)
     1006!
    9601007!    Auteur :  P. Le Van .
    9611008!
    … …  
    14021449          end
    14031450
     1451c-------------------------------------------------------------------------
     1452      SUBROUTINE read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
     1453      implicit none
     1454
     1455c-------------------------------------------------------------------------
     1456c Read I.SANDU case forcing data
     1457c-------------------------------------------------------------------------
     1458
     1459      integer nlev_sandu,nt_sandu
     1460      real ts_sandu(nt_sandu)
     1461      character*80 fich_sandu
     1462
     1463      integer no,l,k,ip
     1464      real riy,rim,rid,rih,bid
     1465
     1466      integer iy,im,id,ih
     1467
     1468       real plev_min
     1469
     1470       plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
     1471
     1472      open(21,file=trim(fich_sandu),form='formatted')
     1473      read(21,'(a)')
     1474      do ip = 1, nt_sandu
     1475      read(21,'(a)')
     1476      read(21,'(a)')
     1477      read(21,223) iy, im, id, ih, ts_sandu(ip)
     1478      print *,'ts=',iy,im,id,ih,ip,ts_sandu(ip)
     1479      enddo
     1480      close(21)
     1481
     1482  223 format(4i3,f8.2)
     1483  226 format(f7.1,1x,10f8.2)
     1484  227 format(f7.1,1x,1p,4e11.3)
     1485  230 format(6f9.3,4e11.3)
     1486
     1487          return
     1488          end
     1489
     1490!=====================================================================
     1491c-------------------------------------------------------------------------
     1492      SUBROUTINE read_astex(fich_astex,nlev_astex,nt_astex,div_astex,
     1493     : ts_astex,ug_astex,vg_astex,ufa_astex,vfa_astex)
     1494      implicit none
     1495
     1496c-------------------------------------------------------------------------
     1497c Read Astex case forcing data
     1498c-------------------------------------------------------------------------
     1499
     1500      integer nlev_astex,nt_astex
     1501      real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
     1502      real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     1503      character*80 fich_astex
     1504
     1505      integer no,l,k,ip
     1506      real riy,rim,rid,rih,bid
     1507
     1508      integer iy,im,id,ih
     1509
     1510       real plev_min
     1511
     1512       plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
     1513
     1514      open(21,file=trim(fich_astex),form='formatted')
     1515      read(21,'(a)')
     1516      read(21,'(a)')
     1517      do ip = 1, nt_astex
     1518      read(21,'(a)')
     1519      read(21,'(a)')
     1520      read(21,223) iy, im, id, ih, div_astex(ip),ts_astex(ip),
     1521     :ug_astex(ip),vg_astex(ip),ufa_astex(ip),vfa_astex(ip)
     1522      ts_astex(ip)=ts_astex(ip)+273.15
     1523      print *,'ts=',iy,im,id,ih,ip,div_astex(ip),ts_astex(ip),
     1524     :ug_astex(ip),vg_astex(ip),ufa_astex(ip),vg_astex(ip)
     1525      enddo
     1526      close(21)
     1527
     1528  223 format(4i3,e13.2,f7.2,f7.3,f7.2,f7.3,f7.2)
     1529  226 format(f7.1,1x,10f8.2)
     1530  227 format(f7.1,1x,1p,4e11.3)
     1531  230 format(6f9.3,4e11.3)
     1532
     1533          return
     1534          end
    14041535!=====================================================================
    14051536      subroutine read_twpice(fich_twpice,nlevel,ntime
    … …  
    18842015       return
    18852016       end
     2017!=====================================================================
     2018
     2019       SUBROUTINE interp_sandu_vertical(play,nlev_sandu,plev_prof
     2020     :         ,t_prof,thl_prof,q_prof,u_prof,v_prof,w_prof
     2021     :         ,omega_prof,o3mmr_prof
     2022     :         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod
     2023     :         ,omega_mod,o3mmr_mod,mxcalc)
     2024
     2025       implicit none
     2026
     2027#include "dimensions.h"
     2028
     2029c-------------------------------------------------------------------------
     2030c Vertical interpolation of SANDUREF forcing data onto model levels
     2031c-------------------------------------------------------------------------
     2032
     2033       integer nlevmax
     2034       parameter (nlevmax=41)
     2035       integer nlev_sandu,mxcalc
     2036!       real play(llm), plev_prof(nlevmax)
     2037!       real t_prof(nlevmax),q_prof(nlevmax)
     2038!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
     2039!       real ht_prof(nlevmax),vt_prof(nlevmax)
     2040!       real hq_prof(nlevmax),vq_prof(nlevmax)
     2041
     2042       real play(llm), plev_prof(nlev_sandu)
     2043       real t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
     2044       real u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
     2045       real omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
     2046
     2047       real t_mod(llm),thl_mod(llm),q_mod(llm)
     2048       real u_mod(llm),v_mod(llm), w_mod(llm)
     2049       real omega_mod(llm),o3mmr_mod(llm)
     2050
     2051       integer l,k,k1,k2,kp
     2052       real aa,frac,frac1,frac2,fact
     2053
     2054       do l = 1, llm
     2055
     2056        if (play(l).ge.plev_prof(nlev_sandu)) then
     2057
     2058        mxcalc=l
     2059         k1=0
     2060         k2=0
     2061
     2062         if (play(l).le.plev_prof(1)) then
     2063
     2064         do k = 1, nlev_sandu-1
     2065          if (play(l).le.plev_prof(k)
     2066     :       .and. play(l).gt.plev_prof(k+1)) then
     2067            k1=k
     2068            k2=k+1
     2069          endif
     2070         enddo
     2071
     2072         if (k1.eq.0 .or. k2.eq.0) then
     2073          write(*,*) 'PB! k1, k2 = ',k1,k2
     2074          write(*,*) 'l,play(l) = ',l,play(l)/100
     2075         do k = 1, nlev_sandu-1
     2076          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
     2077         enddo
     2078         endif
     2079
     2080         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
     2081         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
     2082         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
     2083         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
     2084         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
     2085         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
     2086         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
     2087         omega_mod(l)=omega_prof(k2)-
     2088     :      frac*(omega_prof(k2)-omega_prof(k1))
     2089         o3mmr_mod(l)=o3mmr_prof(k2)-
     2090     :      frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
     2091
     2092         else !play>plev_prof(1)
     2093
     2094         k1=1
     2095         k2=2
     2096         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
     2097         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
     2098         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
     2099         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
     2100         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
     2101         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
     2102         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
     2103         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
     2104         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
     2105         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
     2106
     2107         endif ! play.le.plev_prof(1)
     2108
     2109        else ! above max altitude of forcing file
     2110
     2111cjyg
     2112         fact=20.*(plev_prof(nlev_sandu)-play(l))/plev_prof(nlev_sandu) !jyg
     2113         fact = max(fact,0.)                                           !jyg
     2114         fact = exp(-fact)                                             !jyg
     2115         t_mod(l)= t_prof(nlev_sandu)                                   !jyg
     2116         thl_mod(l)= thl_prof(nlev_sandu)                                   !jyg
     2117         q_mod(l)= q_prof(nlev_sandu)*fact                              !jyg
     2118         u_mod(l)= u_prof(nlev_sandu)*fact                              !jyg
     2119         v_mod(l)= v_prof(nlev_sandu)*fact                              !jyg
     2120         w_mod(l)= w_prof(nlev_sandu)*fact                              !jyg
     2121         omega_mod(l)= omega_prof(nlev_sandu)*fact                      !jyg
     2122         o3mmr_mod(l)= o3mmr_prof(nlev_sandu)*fact                      !jyg
     2123
     2124        endif ! play
     2125
     2126       enddo ! l
     2127
     2128       do l = 1,llm
     2129!      print *,'t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l) ',
     2130!    $        l,t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l)
     2131       enddo
     2132
     2133          return
     2134          end
     2135!=====================================================================
     2136       SUBROUTINE interp_astex_vertical(play,nlev_astex,plev_prof
     2137     :         ,t_prof,thl_prof,qv_prof,ql_prof,qt_prof,u_prof,v_prof
     2138     :         ,w_prof,tke_prof,o3mmr_prof
     2139     :         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod
     2140     :         ,tke_mod,o3mmr_mod,mxcalc)
     2141
     2142       implicit none
     2143
     2144#include "dimensions.h"
     2145
     2146c-------------------------------------------------------------------------
     2147c Vertical interpolation of Astex forcing data onto model levels
     2148c-------------------------------------------------------------------------
     2149
     2150       integer nlevmax
     2151       parameter (nlevmax=41)
     2152       integer nlev_astex,mxcalc
     2153!       real play(llm), plev_prof(nlevmax)
     2154!       real t_prof(nlevmax),qv_prof(nlevmax)
     2155!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
     2156!       real ht_prof(nlevmax),vt_prof(nlevmax)
     2157!       real hq_prof(nlevmax),vq_prof(nlevmax)
     2158
     2159       real play(llm), plev_prof(nlev_astex)
     2160       real t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
     2161       real u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
     2162       real o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
     2163       real qt_prof(nlev_astex),tke_prof(nlev_astex)
     2164
     2165       real t_mod(llm),thl_mod(llm),qv_mod(llm)
     2166       real u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
     2167       real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
     2168
     2169       integer l,k,k1,k2,kp
     2170       real aa,frac,frac1,frac2,fact
     2171
     2172       do l = 1, llm
     2173
     2174        if (play(l).ge.plev_prof(nlev_astex)) then
     2175
     2176        mxcalc=l
     2177         k1=0
     2178         k2=0
     2179
     2180         if (play(l).le.plev_prof(1)) then
     2181
     2182         do k = 1, nlev_astex-1
     2183          if (play(l).le.plev_prof(k)
     2184     :       .and. play(l).gt.plev_prof(k+1)) then
     2185            k1=k
     2186            k2=k+1
     2187          endif
     2188         enddo
     2189
     2190         if (k1.eq.0 .or. k2.eq.0) then
     2191          write(*,*) 'PB! k1, k2 = ',k1,k2
     2192          write(*,*) 'l,play(l) = ',l,play(l)/100
     2193         do k = 1, nlev_astex-1
     2194          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
     2195         enddo
     2196         endif
     2197
     2198         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
     2199         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
     2200         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
     2201         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
     2202         ql_mod(l)= ql_prof(k2) - frac*(ql_prof(k2)-ql_prof(k1))
     2203         qt_mod(l)= qt_prof(k2) - frac*(qt_prof(k2)-qt_prof(k1))
     2204         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
     2205         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
     2206         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
     2207         tke_mod(l)= tke_prof(k2) - frac*(tke_prof(k2)-tke_prof(k1))
     2208         o3mmr_mod(l)=o3mmr_prof(k2)-
     2209     :      frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
     2210
     2211         else !play>plev_prof(1)
     2212
     2213         k1=1
     2214         k2=2
     2215         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
     2216         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
     2217         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
     2218         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
     2219         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
     2220         ql_mod(l)= frac1*ql_prof(k1) - frac2*ql_prof(k2)
     2221         qt_mod(l)= frac1*qt_prof(k1) - frac2*qt_prof(k2)
     2222         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
     2223         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
     2224         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
     2225         tke_mod(l)= frac1*tke_prof(k1) - frac2*tke_prof(k2)
     2226         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
     2227
     2228         endif ! play.le.plev_prof(1)
     2229
     2230        else ! above max altitude of forcing file
     2231
     2232cjyg
     2233         fact=20.*(plev_prof(nlev_astex)-play(l))/plev_prof(nlev_astex) !jyg
     2234         fact = max(fact,0.)                                           !jyg
     2235         fact = exp(-fact)                                             !jyg
     2236         t_mod(l)= t_prof(nlev_astex)                                   !jyg
     2237         thl_mod(l)= thl_prof(nlev_astex)                                   !jyg
     2238         qv_mod(l)= qv_prof(nlev_astex)*fact                              !jyg
     2239         ql_mod(l)= ql_prof(nlev_astex)*fact                              !jyg
     2240         qt_mod(l)= qt_prof(nlev_astex)*fact                              !jyg
     2241         u_mod(l)= u_prof(nlev_astex)*fact                              !jyg
     2242         v_mod(l)= v_prof(nlev_astex)*fact                              !jyg
     2243         w_mod(l)= w_prof(nlev_astex)*fact                              !jyg
     2244         tke_mod(l)= tke_prof(nlev_astex)*fact                              !jyg
     2245         o3mmr_mod(l)= o3mmr_prof(nlev_astex)*fact                      !jyg
     2246
     2247        endif ! play
     2248
     2249       enddo ! l
     2250
     2251       do l = 1,llm
     2252!      print *,'t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l) ',
     2253!    $        l,t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l)
     2254       enddo
     2255
     2256          return
     2257          end
    18862258
    18872259!======================================================================
    … …  
    20482420          end
    20492421
     2422!======================================================================
     2423        SUBROUTINE interp_sandu_time(day,day1,annee_ref
     2424     i             ,year_ini_sandu,day_ini_sandu,nt_sandu,dt_sandu
     2425     i             ,nlev_sandu,ts_sandu,ts_prof)
     2426        implicit none
     2427
     2428!---------------------------------------------------------------------------------------
     2429! Time interpolation of a 2D field to the timestep corresponding to day
     2430!
     2431! day: current julian day (e.g. 717538.2)
     2432! day1: first day of the simulation
     2433! nt_sandu: total nb of data in the forcing (e.g. 13 for Sanduref)
     2434! dt_sandu: total time interval (in sec) between 2 forcing data (e.g. 6h for Sanduref)
     2435!---------------------------------------------------------------------------------------
     2436! inputs:
     2437        integer annee_ref
     2438        integer nt_sandu,nlev_sandu
     2439        integer year_ini_sandu
     2440        real day, day1,day_ini_sandu,dt_sandu
     2441        real ts_sandu(nt_sandu)
     2442! outputs:
     2443        real ts_prof
     2444! local:
     2445        integer it_sandu1, it_sandu2,k
     2446        real timeit,time_sandu1,time_sandu2,frac
     2447! Check that initial day of the simulation consistent with SANDU period:
     2448       if (annee_ref.ne.2006 ) then
     2449        print*,'Pour SANDUREF, annee_ref doit etre 2006 '
     2450        print*,'Changer annee_ref dans run.def'
     2451        stop
     2452       endif
     2453!      if (annee_ref.eq.2006 .and. day1.lt.day_ini_sandu) then
     2454!       print*,'SANDUREF debute le 15 Juillet 2006 (jour julien=196)'
     2455!       print*,'Changer dayref dans run.def'
     2456!       stop
     2457!      endif
     2458
     2459! Determine timestep relative to the 1st day of TOGA-COARE:
     2460!       timeit=(day-day1)*86400.
     2461!       if (annee_ref.eq.1992) then
     2462!        timeit=(day-day_ini_sandu)*86400.
     2463!       else
     2464!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     2465!       endif
     2466      timeit=(day-day_ini_sandu)*86400
     2467
     2468! Determine the closest observation times:
     2469       it_sandu1=INT(timeit/dt_sandu)+1
     2470       it_sandu2=it_sandu1 + 1
     2471       time_sandu1=(it_sandu1-1)*dt_sandu
     2472       time_sandu2=(it_sandu2-1)*dt_sandu
     2473       print *,'timeit day day_ini_sandu',timeit,day,day_ini_sandu
     2474       print *,'it_sandu1,it_sandu2,time_sandu1,time_sandu2',
     2475     .          it_sandu1,it_sandu2,time_sandu1,time_sandu2
     2476
     2477       if (it_sandu1 .ge. nt_sandu) then
     2478        write(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '
     2479     :        ,day,it_sandu1,it_sandu2,timeit/86400.
     2480        stop
     2481       endif
     2482
     2483! time interpolation:
     2484       frac=(time_sandu2-timeit)/(time_sandu2-time_sandu1)
     2485       frac=max(frac,0.0)
     2486
     2487       ts_prof = ts_sandu(it_sandu2)
     2488     :          -frac*(ts_sandu(it_sandu2)-ts_sandu(it_sandu1))
     2489
     2490         print*,
     2491     :'day,annee_ref,day_ini_sandu,timeit,it_sandu1,it_sandu2,SST:',
     2492     :day,annee_ref,day_ini_sandu,timeit/86400.,it_sandu1,
     2493     :it_sandu2,ts_prof
     2494
     2495        return
     2496        END
    20502497!=====================================================================
    20512498c-------------------------------------------------------------------------
    … …  
    22092656          end
    22102657 
     2658!======================================================================
     2659        SUBROUTINE interp_astex_time(day,day1,annee_ref
     2660     i             ,year_ini_astex,day_ini_astex,nt_astex,dt_astex
     2661     i             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex
     2662     i             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof
     2663     i             ,ufa_prof,vfa_prof)
     2664        implicit none
     2665
     2666!---------------------------------------------------------------------------------------
     2667! Time interpolation of a 2D field to the timestep corresponding to day
     2668!
     2669! day: current julian day (e.g. 717538.2)
     2670! day1: first day of the simulation
     2671! nt_astex: total nb of data in the forcing (e.g. 41 for Astex)
     2672! dt_astex: total time interval (in sec) between 2 forcing data (e.g. 1h for Astex)
     2673!---------------------------------------------------------------------------------------
     2674
     2675! inputs:
     2676        integer annee_ref
     2677        integer nt_astex,nlev_astex
     2678        integer year_ini_astex
     2679        real day, day1,day_ini_astex,dt_astex
     2680        real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
     2681        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     2682! outputs:
     2683        real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
     2684! local:
     2685        integer it_astex1, it_astex2,k
     2686        real timeit,time_astex1,time_astex2,frac
     2687
     2688! Check that initial day of the simulation consistent with ASTEX period:
     2689       if (annee_ref.ne.1992 ) then
     2690        print*,'Pour Astex, annee_ref doit etre 1992 '
     2691        print*,'Changer annee_ref dans run.def'
     2692        stop
     2693       endif
     2694       if (annee_ref.eq.1992 .and. day1.lt.day_ini_astex) then
     2695        print*,'Astex debute le 13 Juin 1992 (jour julien=165)'
     2696        print*,'Changer dayref dans run.def'
     2697        stop
     2698       endif
     2699
     2700! Determine timestep relative to the 1st day of TOGA-COARE:
     2701!       timeit=(day-day1)*86400.
     2702!       if (annee_ref.eq.1992) then
     2703!        timeit=(day-day_ini_astex)*86400.
     2704!       else
     2705!        timeit=(day+2.-1.)*86400. ! 2 days between Jun13 and Jun15 1992
     2706!       endif
     2707      timeit=(day-day_ini_astex)*86400
     2708
     2709! Determine the closest observation times:
     2710       it_astex1=INT(timeit/dt_astex)+1
     2711       it_astex2=it_astex1 + 1
     2712       time_astex1=(it_astex1-1)*dt_astex
     2713       time_astex2=(it_astex2-1)*dt_astex
     2714       print *,'timeit day day_ini_astex',timeit,day,day_ini_astex
     2715       print *,'it_astex1,it_astex2,time_astex1,time_astex2',
     2716     .          it_astex1,it_astex2,time_astex1,time_astex2
     2717
     2718       if (it_astex1 .ge. nt_astex) then
     2719        write(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '
     2720     :        ,day,it_astex1,it_astex2,timeit/86400.
     2721        stop
     2722       endif
     2723
     2724! time interpolation:
     2725       frac=(time_astex2-timeit)/(time_astex2-time_astex1)
     2726       frac=max(frac,0.0)
     2727
     2728       div_prof = div_astex(it_astex2)
     2729     :          -frac*(div_astex(it_astex2)-div_astex(it_astex1))
     2730       ts_prof = ts_astex(it_astex2)
     2731     :          -frac*(ts_astex(it_astex2)-ts_astex(it_astex1))
     2732       ug_prof = ug_astex(it_astex2)
     2733     :          -frac*(ug_astex(it_astex2)-ug_astex(it_astex1))
     2734       vg_prof = vg_astex(it_astex2)
     2735     :          -frac*(vg_astex(it_astex2)-vg_astex(it_astex1))
     2736       ufa_prof = ufa_astex(it_astex2)
     2737     :          -frac*(ufa_astex(it_astex2)-ufa_astex(it_astex1))
     2738       vfa_prof = vfa_astex(it_astex2)
     2739     :          -frac*(vfa_astex(it_astex2)-vfa_astex(it_astex1))
     2740
     2741         print*,
     2742     :'day,annee_ref,day_ini_astex,timeit,it_astex1,it_astex2,SST:',
     2743     :day,annee_ref,day_ini_astex,timeit/86400.,it_astex1,
     2744     :it_astex2,div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
     2745
     2746        return
     2747        END
     2748
    22112749!======================================================================
    22122750        SUBROUTINE interp_toga_time(day,day1,annee_ref
    … …  
    24793017        return
    24803018        end
     3019!======================================================================
     3020      subroutine readprofile_sandu(nlev_max,kmax,height,pprof,tprof,
     3021     .       thlprof,qprof,uprof,vprof,wprof,omega,o3mmr)
     3022!======================================================================
     3023      implicit none
     3024
     3025        integer nlev_max,kmax,kmax2
     3026        logical :: llesread = .true.
     3027
     3028        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),
     3029     .  thlprof(nlev_max),
     3030     .  qprof(nlev_max),uprof(nlev_max),vprof(nlev_max),
     3031     .  wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
     3032
     3033        integer, parameter :: ilesfile=1
     3034        integer :: ierr,irad,imax,jtot,k
     3035        logical :: lmoist,lcoriol,ltimedep
     3036        real :: xsize,ysize
     3037        real :: ustin,wsvsurf,timerad
     3038        character(80) :: chmess
     3039
     3040        if(.not.(llesread)) return
     3041
     3042       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
     3043        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
     3044        read (ilesfile,*) kmax
     3045        do k=1,kmax
     3046          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),
     3047     .                      qprof (k),uprof(k),  vprof(k),  wprof(k),
     3048     .                      omega (k),o3mmr(k)
     3049        enddo
     3050        close(ilesfile)
     3051
     3052        return
     3053        end
     3054
     3055!======================================================================
     3056      subroutine readprofile_astex(nlev_max,kmax,height,pprof,tprof,
     3057     .    thlprof,qvprof,qlprof,qtprof,uprof,vprof,wprof,tkeprof,o3mmr)
     3058!======================================================================
     3059      implicit none
     3060
     3061        integer nlev_max,kmax,kmax2
     3062        logical :: llesread = .true.
     3063
     3064        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),
     3065     .  thlprof(nlev_max),qlprof(nlev_max),qtprof(nlev_max),
     3066     .  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),
     3067     .  wprof(nlev_max),tkeprof(nlev_max),o3mmr(nlev_max)
     3068
     3069        integer, parameter :: ilesfile=1
     3070        integer :: ierr,irad,imax,jtot,k
     3071        logical :: lmoist,lcoriol,ltimedep
     3072        real :: xsize,ysize
     3073        real :: ustin,wsvsurf,timerad
     3074        character(80) :: chmess
     3075
     3076        if(.not.(llesread)) return
     3077
     3078       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
     3079        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
     3080        read (ilesfile,*) kmax
     3081        do k=1,kmax
     3082          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),
     3083     .                qvprof (k),qlprof (k),qtprof (k),
     3084     .                uprof(k),  vprof(k),  wprof(k),tkeprof(k),o3mmr(k)
     3085        enddo
     3086        close(ilesfile)
     3087
     3088        return
     3089        end
     3090
    24813091
    24823092
    … …  
    25393149        return
    25403150        end
    2541 !===============================================================
    2542       function ismin(n,sx,incx)
     3151!=====================================================================
     3152      subroutine read_amma(fich_amma,nlevel,ntime
     3153     :     ,zz,pp,temp,qv,u,v,dw
     3154     :     ,dt,dq,sens,flat)
     3155
     3156!program reading forcings of the AMMA case study
     3157
    25433158
    25443159      implicit none
    2545       integer n,i,incx,ismin,ix
    2546       real sx((n-1)*incx+1),sxmin
    2547 
    2548       ix=1
    2549       ismin=1
    2550       sxmin=sx(1)
    2551       do i=1,n-1
    2552          ix=ix+incx
    2553          if(sx(ix).lt.sxmin) then
    2554              sxmin=sx(ix)
    2555              ismin=i+1
    2556          endif
    2557       enddo
    2558 
    2559       return
    2560       end
    2561 
    2562 !===============================================================
    2563       function ismax(n,sx,incx)
     3160
     3161#include "netcdf.inc"
     3162
     3163      integer ntime,nlevel
     3164      integer l,k
     3165      character*80 :: fich_amma
     3166      real*8 time(ntime)
     3167      real*8 zz(nlevel)
     3168
     3169      real*8 temp(nlevel),pp(nlevel)
     3170      real*8 qv(nlevel),u(nlevel)
     3171      real*8 v(nlevel)
     3172      real*8 dw(nlevel,ntime)
     3173      real*8 dt(nlevel,ntime)
     3174      real*8 dq(nlevel,ntime)   
     3175      real*8 flat(ntime),sens(ntime)
     3176
     3177      integer nid, ierr
     3178      integer nbvar3d
     3179      parameter(nbvar3d=30)
     3180      integer var3didin(nbvar3d)
     3181
     3182      ierr = NF_OPEN(fich_amma,NF_NOWRITE,nid)
     3183      if (ierr.NE.NF_NOERR) then
     3184         write(*,*) 'ERROR: Pb opening forcings nc file '
     3185         write(*,*) NF_STRERROR(ierr)
     3186         stop ""
     3187      endif
     3188
     3189
     3190       ierr=NF_INQ_VARID(nid,"zz",var3didin(1))
     3191         if(ierr/=NF_NOERR) then
     3192           write(*,*) NF_STRERROR(ierr)
     3193           stop 'lev'
     3194         endif
     3195
     3196
     3197      ierr=NF_INQ_VARID(nid,"temp",var3didin(2))
     3198         if(ierr/=NF_NOERR) then
     3199           write(*,*) NF_STRERROR(ierr)
     3200           stop 'temp'
     3201         endif
     3202
     3203      ierr=NF_INQ_VARID(nid,"qv",var3didin(3))
     3204         if(ierr/=NF_NOERR) then
     3205           write(*,*) NF_STRERROR(ierr)
     3206           stop 'qv'
     3207         endif
     3208
     3209      ierr=NF_INQ_VARID(nid,"u",var3didin(4))
     3210         if(ierr/=NF_NOERR) then
     3211           write(*,*) NF_STRERROR(ierr)
     3212           stop 'u'
     3213         endif
     3214
     3215      ierr=NF_INQ_VARID(nid,"v",var3didin(5))
     3216         if(ierr/=NF_NOERR) then
     3217           write(*,*) NF_STRERROR(ierr)
     3218           stop 'v'
     3219         endif
     3220
     3221      ierr=NF_INQ_VARID(nid,"dw",var3didin(6))
     3222         if(ierr/=NF_NOERR) then
     3223           write(*,*) NF_STRERROR(ierr)
     3224           stop 'dw'
     3225         endif
     3226
     3227      ierr=NF_INQ_VARID(nid,"dt",var3didin(7))
     3228         if(ierr/=NF_NOERR) then
     3229           write(*,*) NF_STRERROR(ierr)
     3230           stop 'dt'
     3231         endif
     3232
     3233      ierr=NF_INQ_VARID(nid,"dq",var3didin(8))
     3234         if(ierr/=NF_NOERR) then
     3235           write(*,*) NF_STRERROR(ierr)
     3236           stop 'dq'
     3237         endif
     3238     
     3239      ierr=NF_INQ_VARID(nid,"sens",var3didin(9))
     3240         if(ierr/=NF_NOERR) then
     3241           write(*,*) NF_STRERROR(ierr)
     3242           stop 'sens'
     3243         endif
     3244
     3245      ierr=NF_INQ_VARID(nid,"flat",var3didin(10))
     3246         if(ierr/=NF_NOERR) then
     3247           write(*,*) NF_STRERROR(ierr)
     3248           stop 'flat'
     3249         endif
     3250
     3251      ierr=NF_INQ_VARID(nid,"pp",var3didin(11))
     3252         if(ierr/=NF_NOERR) then
     3253           write(*,*) NF_STRERROR(ierr)
     3254           stop 'pp'
     3255      endif
     3256
     3257!dimensions lecture
     3258!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
     3259 
     3260#ifdef NC_DOUBLE
     3261         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
     3262#else
     3263         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
     3264#endif
     3265         if(ierr/=NF_NOERR) then
     3266            write(*,*) NF_STRERROR(ierr)
     3267            stop "getvarup"
     3268         endif
     3269!          write(*,*)'lecture z ok',zz
     3270
     3271#ifdef NC_DOUBLE
     3272         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),temp)
     3273#else
     3274         ierr = NF_GET_VAR_REAL(nid,var3didin(2),temp)
     3275#endif
     3276         if(ierr/=NF_NOERR) then
     3277            write(*,*) NF_STRERROR(ierr)
     3278            stop "getvarup"
     3279         endif
     3280!          write(*,*)'lecture th ok',temp
     3281
     3282#ifdef NC_DOUBLE
     3283         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qv)
     3284#else
     3285         ierr = NF_GET_VAR_REAL(nid,var3didin(3),qv)
     3286#endif
     3287         if(ierr/=NF_NOERR) then
     3288            write(*,*) NF_STRERROR(ierr)
     3289            stop "getvarup"
     3290         endif
     3291!          write(*,*)'lecture qv ok',qv
     3292 
     3293#ifdef NC_DOUBLE
     3294         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
     3295#else
     3296         ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
     3297#endif
     3298         if(ierr/=NF_NOERR) then
     3299            write(*,*) NF_STRERROR(ierr)
     3300            stop "getvarup"
     3301         endif
     3302!          write(*,*)'lecture u ok',u
     3303
     3304#ifdef NC_DOUBLE
     3305         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
     3306#else
     3307         ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
     3308#endif
     3309         if(ierr/=NF_NOERR) then
     3310            write(*,*) NF_STRERROR(ierr)
     3311            stop "getvarup"
     3312         endif
     3313!          write(*,*)'lecture v ok',v
     3314
     3315#ifdef NC_DOUBLE
     3316         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),dw)
     3317#else
     3318         ierr = NF_GET_VAR_REAL(nid,var3didin(6),dw)
     3319#endif
     3320         if(ierr/=NF_NOERR) then
     3321            write(*,*) NF_STRERROR(ierr)
     3322            stop "getvarup"
     3323         endif
     3324!          write(*,*)'lecture w ok',dw
     3325
     3326#ifdef NC_DOUBLE
     3327         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),dt)
     3328#else
     3329         ierr = NF_GET_VAR_REAL(nid,var3didin(7),dt)
     3330#endif
     3331         if(ierr/=NF_NOERR) then
     3332            write(*,*) NF_STRERROR(ierr)
     3333            stop "getvarup"
     3334         endif
     3335!          write(*,*)'lecture dt ok',dt
     3336
     3337#ifdef NC_DOUBLE
     3338         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),dq)
     3339#else
     3340         ierr = NF_GET_VAR_REAL(nid,var3didin(8),dq)
     3341#endif
     3342         if(ierr/=NF_NOERR) then
     3343            write(*,*) NF_STRERROR(ierr)
     3344            stop "getvarup"
     3345         endif
     3346!          write(*,*)'lecture dq ok',dq
     3347
     3348#ifdef NC_DOUBLE
     3349         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),sens)
     3350#else
     3351         ierr = NF_GET_VAR_REAL(nid,var3didin(9),sens)
     3352#endif
     3353         if(ierr/=NF_NOERR) then
     3354            write(*,*) NF_STRERROR(ierr)
     3355            stop "getvarup"
     3356         endif
     3357!          write(*,*)'lecture sens ok',sens
     3358
     3359#ifdef NC_DOUBLE
     3360         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),flat)
     3361#else
     3362         ierr = NF_GET_VAR_REAL(nid,var3didin(10),flat)
     3363#endif
     3364         if(ierr/=NF_NOERR) then
     3365            write(*,*) NF_STRERROR(ierr)
     3366            stop "getvarup"
     3367         endif
     3368!          write(*,*)'lecture flat ok',flat
     3369
     3370#ifdef NC_DOUBLE
     3371         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pp)
     3372#else
     3373         ierr = NF_GET_VAR_REAL(nid,var3didin(11),pp)
     3374#endif
     3375         if(ierr/=NF_NOERR) then
     3376            write(*,*) NF_STRERROR(ierr)
     3377            stop "getvarup"
     3378         endif
     3379!          write(*,*)'lecture pp ok',pp
     3380
     3381         return
     3382         end subroutine read_amma
     3383!======================================================================
     3384        SUBROUTINE interp_amma_time(day,day1,annee_ref
     3385     i         ,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma
     3386     i         ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma
     3387     o         ,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof)
     3388        implicit none
     3389
     3390!---------------------------------------------------------------------------------------
     3391! Time interpolation of a 2D field to the timestep corresponding to day
     3392!
     3393! day: current julian day (e.g. 717538.2)
     3394! day1: first day of the simulation
     3395! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
     3396! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
     3397!---------------------------------------------------------------------------------------
     3398
     3399#include "compar1d.h"
     3400
     3401! inputs:
     3402        integer annee_ref
     3403        integer nt_amma,nlev_amma
     3404        integer year_ini_amma
     3405        real day, day1,day_ini_amma,dt_amma
     3406        real vitw_amma(nlev_amma,nt_amma)
     3407        real ht_amma(nlev_amma,nt_amma)
     3408        real hq_amma(nlev_amma,nt_amma)
     3409        real lat_amma(nt_amma)
     3410        real sens_amma(nt_amma)
     3411! outputs:
     3412        real vitw_prof(nlev_amma)
     3413        real ht_prof(nlev_amma)
     3414        real hq_prof(nlev_amma)
     3415        real lat_prof,sens_prof
     3416! local:
     3417        integer it_amma1, it_amma2,k
     3418        real timeit,time_amma1,time_amma2,frac
     3419
     3420
     3421        if (forcing_type.eq.6) then
     3422! Check that initial day of the simulation consistent with AMMA case:
     3423       if (annee_ref.ne.2006) then
     3424        print*,'Pour AMMA, annee_ref doit etre 2006'
     3425        print*,'Changer annee_ref dans run.def'
     3426        stop
     3427       endif
     3428       if (annee_ref.eq.2006 .and. day1.lt.day_ini_amma) then
     3429        print*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
     3430        print*,'Changer dayref dans run.def'
     3431        stop
     3432       endif
     3433       if (annee_ref.eq.2006 .and. day1.gt.day_ini_amma+1) then
     3434        print*,'AMMA a fini le 11 juillet'
     3435        print*,'Changer dayref ou nday dans run.def'
     3436        stop
     3437       endif
     3438       endif
     3439
     3440! Determine timestep relative to the 1st day of AMMA:
     3441!       timeit=(day-day1)*86400.
     3442!       if (annee_ref.eq.1992) then
     3443!        timeit=(day-day_ini_toga)*86400.
     3444!       else
     3445!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
     3446!       endif
     3447      timeit=(day-day_ini_amma)*86400
     3448
     3449! Determine the closest observation times:
     3450!       it_amma1=INT(timeit/dt_amma)+1
     3451!       it_amma2=it_amma1 + 1
     3452!       time_amma1=(it_amma1-1)*dt_amma
     3453!       time_amma2=(it_amma2-1)*dt_amma
     3454
     3455       it_amma1=INT(timeit/dt_amma)+1
     3456       IF (it_amma1 .EQ. nt_amma) THEN
     3457       it_amma2=it_amma1
     3458       ELSE
     3459       it_amma2=it_amma1 + 1
     3460       ENDIF
     3461       time_amma1=(it_amma1-1)*dt_amma
     3462       time_amma2=(it_amma2-1)*dt_amma
     3463
     3464       if (it_amma1 .gt. nt_amma) then
     3465        write(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '
     3466     :        ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
     3467        stop
     3468       endif
     3469
     3470! time interpolation:
     3471       frac=(time_amma2-timeit)/(time_amma2-time_amma1)
     3472       frac=max(frac,0.0)
     3473
     3474       lat_prof = lat_amma(it_amma2)
     3475     :          -frac*(lat_amma(it_amma2)-lat_amma(it_amma1))
     3476       sens_prof = sens_amma(it_amma2)
     3477     :          -frac*(sens_amma(it_amma2)-sens_amma(it_amma1))
     3478
     3479       do k=1,nlev_amma
     3480        vitw_prof(k) = vitw_amma(k,it_amma2)
     3481     :          -frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1))
     3482        ht_prof(k) = ht_amma(k,it_amma2)
     3483     :          -frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1))
     3484        hq_prof(k) = hq_amma(k,it_amma2)
     3485     :          -frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1))
     3486        enddo
     3487
     3488        return
     3489        END
     3490
     3491!=====================================================================
     3492      subroutine read_fire(fich_fire,nlevel,ntime
     3493     :     ,zz,thl,qt,u,v,tke
     3494     :     ,ug,vg,wls,dqtdx,dqtdy,dqtdt,thl_rad)
     3495
     3496!program reading forcings of the FIRE case study
     3497
    25643498
    25653499      implicit none
    2566       integer n,i,incx,ismax,ix
    2567       real sx((n-1)*incx+1),sxmax
    2568 
    2569       ix=1
    2570       ismax=1
    2571       sxmax=sx(1)
    2572       do i=1,n-1
    2573          ix=ix+incx
    2574          if(sx(ix).gt.sxmax) then
    2575              sxmax=sx(ix)
    2576              ismax=i+1
    2577          endif
    2578       enddo
    2579 
    2580       return
    2581       end
    2582 
     3500
     3501#include "netcdf.inc"
     3502
     3503      integer ntime,nlevel
     3504      integer l,k
     3505      character*80 :: fich_fire
     3506      real*8 time(ntime)
     3507      real*8 zz(nlevel)
     3508
     3509      real*8 thl(nlevel)
     3510      real*8 qt(nlevel),u(nlevel)
     3511      real*8 v(nlevel),tke(nlevel)
     3512      real*8 ug(nlevel,ntime),vg(nlevel,ntime),wls(nlevel,ntime)
     3513      real*8 dqtdx(nlevel,ntime),dqtdy(nlevel,ntime)
     3514      real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime) 
     3515
     3516      integer nid, ierr
     3517      integer nbvar3d
     3518      parameter(nbvar3d=30)
     3519      integer var3didin(nbvar3d)
     3520
     3521      ierr = NF_OPEN(fich_fire,NF_NOWRITE,nid)
     3522      if (ierr.NE.NF_NOERR) then
     3523         write(*,*) 'ERROR: Pb opening forcings nc file '
     3524         write(*,*) NF_STRERROR(ierr)
     3525         stop ""
     3526      endif
     3527
     3528
     3529       ierr=NF_INQ_VARID(nid,"zz",var3didin(1))
     3530         if(ierr/=NF_NOERR) then
     3531           write(*,*) NF_STRERROR(ierr)
     3532           stop 'lev'
     3533         endif
     3534
     3535
     3536      ierr=NF_INQ_VARID(nid,"thetal",var3didin(2))
     3537         if(ierr/=NF_NOERR) then
     3538           write(*,*) NF_STRERROR(ierr)
     3539           stop 'temp'
     3540         endif
     3541
     3542      ierr=NF_INQ_VARID(nid,"qt",var3didin(3))
     3543         if(ierr/=NF_NOERR) then
     3544           write(*,*) NF_STRERROR(ierr)
     3545           stop 'qv'
     3546         endif
     3547
     3548      ierr=NF_INQ_VARID(nid,"u",var3didin(4))
     3549         if(ierr/=NF_NOERR) then
     3550           write(*,*) NF_STRERROR(ierr)
     3551           stop 'u'
     3552         endif
     3553
     3554      ierr=NF_INQ_VARID(nid,"v",var3didin(5))
     3555         if(ierr/=NF_NOERR) then
     3556           write(*,*) NF_STRERROR(ierr)
     3557           stop 'v'
     3558         endif
     3559
     3560      ierr=NF_INQ_VARID(nid,"tke",var3didin(6))
     3561         if(ierr/=NF_NOERR) then
     3562           write(*,*) NF_STRERROR(ierr)
     3563           stop 'tke'
     3564         endif
     3565
     3566      ierr=NF_INQ_VARID(nid,"ugeo",var3didin(7))
     3567         if(ierr/=NF_NOERR) then
     3568           write(*,*) NF_STRERROR(ierr)
     3569           stop 'ug'
     3570         endif
     3571
     3572      ierr=NF_INQ_VARID(nid,"vgeo",var3didin(8))
     3573         if(ierr/=NF_NOERR) then
     3574           write(*,*) NF_STRERROR(ierr)
     3575           stop 'vg'
     3576         endif
     3577     
     3578      ierr=NF_INQ_VARID(nid,"wls",var3didin(9))
     3579         if(ierr/=NF_NOERR) then
     3580           write(*,*) NF_STRERROR(ierr)
     3581           stop 'wls'
     3582         endif
     3583
     3584      ierr=NF_INQ_VARID(nid,"dqtdx",var3didin(10))
     3585         if(ierr/=NF_NOERR) then
     3586           write(*,*) NF_STRERROR(ierr)
     3587           stop 'dqtdx'
     3588         endif
     3589
     3590      ierr=NF_INQ_VARID(nid,"dqtdy",var3didin(11))
     3591         if(ierr/=NF_NOERR) then
     3592           write(*,*) NF_STRERROR(ierr)
     3593           stop 'dqtdy'
     3594      endif
     3595
     3596      ierr=NF_INQ_VARID(nid,"dqtdt",var3didin(12))
     3597         if(ierr/=NF_NOERR) then
     3598           write(*,*) NF_STRERROR(ierr)
     3599           stop 'dqtdt'
     3600      endif
     3601
     3602      ierr=NF_INQ_VARID(nid,"thl_rad",var3didin(13))
     3603         if(ierr/=NF_NOERR) then
     3604           write(*,*) NF_STRERROR(ierr)
     3605           stop 'thl_rad'
     3606      endif
     3607!dimensions lecture
     3608!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
     3609 
     3610#ifdef NC_DOUBLE
     3611         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
     3612#else
     3613         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
     3614#endif
     3615         if(ierr/=NF_NOERR) then
     3616            write(*,*) NF_STRERROR(ierr)
     3617            stop "getvarup"
     3618         endif
     3619!          write(*,*)'lecture z ok',zz
     3620
     3621#ifdef NC_DOUBLE
     3622         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),thl)
     3623#else
     3624         ierr = NF_GET_VAR_REAL(nid,var3didin(2),thl)
     3625#endif
     3626         if(ierr/=NF_NOERR) then
     3627            write(*,*) NF_STRERROR(ierr)
     3628            stop "getvarup"
     3629         endif
     3630!          write(*,*)'lecture thl ok',thl
     3631
     3632#ifdef NC_DOUBLE
     3633         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qt)
     3634#else
     3635         ierr = NF_GET_VAR_REAL(nid,var3didin(3),qt)
     3636#endif
     3637         if(ierr/=NF_NOERR) then
     3638            write(*,*) NF_STRERROR(ierr)
     3639            stop "getvarup"
     3640         endif
     3641!          write(*,*)'lecture qt ok',qt
     3642 
     3643#ifdef NC_DOUBLE
     3644         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
     3645#else
     3646         ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
     3647#endif
     3648         if(ierr/=NF_NOERR) then
     3649            write(*,*) NF_STRERROR(ierr)
     3650            stop "getvarup"
     3651         endif
     3652!          write(*,*)'lecture u ok',u
     3653
     3654#ifdef NC_DOUBLE
     3655         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
     3656#else
     3657         ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
     3658#endif
     3659         if(ierr/=NF_NOERR) then
     3660            write(*,*) NF_STRERROR(ierr)
     3661            stop "getvarup"
     3662         endif
     3663!          write(*,*)'lecture v ok',v
     3664
     3665#ifdef NC_DOUBLE
     3666         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tke)
     3667#else
     3668         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tke)
     3669#endif
     3670         if(ierr/=NF_NOERR) then
     3671            write(*,*) NF_STRERROR(ierr)
     3672            stop "getvarup"
     3673         endif
     3674!          write(*,*)'lecture tke ok',tke
     3675
     3676#ifdef NC_DOUBLE
     3677         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ug)
     3678#else
     3679         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ug)
     3680#endif
     3681         if(ierr/=NF_NOERR) then
     3682            write(*,*) NF_STRERROR(ierr)
     3683            stop "getvarup"
     3684         endif
     3685!          write(*,*)'lecture ug ok',ug
     3686
     3687#ifdef NC_DOUBLE
     3688         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),vg)
     3689#else
     3690         ierr = NF_GET_VAR_REAL(nid,var3didin(8),vg)
     3691#endif
     3692         if(ierr/=NF_NOERR) then
     3693            write(*,*) NF_STRERROR(ierr)
     3694            stop "getvarup"
     3695         endif
     3696!          write(*,*)'lecture vg ok',vg
     3697
     3698#ifdef NC_DOUBLE
     3699         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),wls)
     3700#else
     3701         ierr = NF_GET_VAR_REAL(nid,var3didin(9),wls)
     3702#endif
     3703         if(ierr/=NF_NOERR) then
     3704            write(*,*) NF_STRERROR(ierr)
     3705            stop "getvarup"
     3706         endif
     3707!          write(*,*)'lecture wls ok',wls
     3708
     3709#ifdef NC_DOUBLE
     3710         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),dqtdx)
     3711#else
     3712         ierr = NF_GET_VAR_REAL(nid,var3didin(10),dqtdx)
     3713#endif
     3714         if(ierr/=NF_NOERR) then
     3715            write(*,*) NF_STRERROR(ierr)
     3716            stop "getvarup"
     3717         endif
     3718!          write(*,*)'lecture dqtdx ok',dqtdx
     3719
     3720#ifdef NC_DOUBLE
     3721         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),dqtdy)
     3722#else
     3723         ierr = NF_GET_VAR_REAL(nid,var3didin(11),dqtdy)
     3724#endif
     3725         if(ierr/=NF_NOERR) then
     3726            write(*,*) NF_STRERROR(ierr)
     3727            stop "getvarup"
     3728         endif
     3729!          write(*,*)'lecture dqtdy ok',dqtdy
     3730
     3731#ifdef NC_DOUBLE
     3732         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),dqtdt)
     3733#else
     3734         ierr = NF_GET_VAR_REAL(nid,var3didin(12),dqtdt)
     3735#endif
     3736         if(ierr/=NF_NOERR) then
     3737            write(*,*) NF_STRERROR(ierr)
     3738            stop "getvarup"
     3739         endif
     3740!          write(*,*)'lecture dqtdt ok',dqtdt
     3741
     3742#ifdef NC_DOUBLE
     3743         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),thl_rad)
     3744#else
     3745         ierr = NF_GET_VAR_REAL(nid,var3didin(13),thl_rad)
     3746#endif
     3747         if(ierr/=NF_NOERR) then
     3748            write(*,*) NF_STRERROR(ierr)
     3749            stop "getvarup"
     3750         endif
     3751!          write(*,*)'lecture thl_rad ok',thl_rad
     3752
     3753         return
     3754         end subroutine read_fire

  • LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim

    r1707 r1795  
    125125       ok_flux_surf = .FALSE.
    126126       CALL getin('ok_flux_surf',ok_flux_surf)
     127
     128!Config  Key  = ok_old_disvert
     129!Config  Desc = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
     130!Config  Def  = false
     131!Config  Help = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
     132       ok_old_disvert = .FALSE.
     133       CALL getin('ok_old_disvert',ok_old_disvert)
    127134
    128135!Config  Key  = time_ini
    … …  
    703710      RETURN
    704711      END
    705       subroutine scopy(n,sx,incx,sy,incy)
    706 !
    707       IMPLICIT NONE
    708 !
    709       integer n,incx,incy,ix,iy,i
    710       real sx((n-1)*incx+1),sy((n-1)*incy+1)
    711 !
    712       iy=1
    713       ix=1
    714       do 10 i=1,n
    715          sy(iy)=sx(ix)
    716          ix=ix+incx
    717          iy=iy+incy
    718 10    continue
    719 !
    720       return
    721       end
    722712      subroutine wrgradsfi(if,nl,field,name,titlevar)
    723713      implicit none
    … …  
    10791069 
    10801070!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1081       SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
     1071      SUBROUTINE disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
    10821072 
    10831073!    Auteur :  P. Le Van .
    … …  
    26622652        return
    26632653        end
    2664 !===============================================================
    2665       function ismin(n,sx,incx)
    2666 
    2667       implicit none
    2668       integer n,i,incx,ismin,ix
    2669       real sx((n-1)*incx+1),sxmin
    2670 
    2671       ix=1
    2672       ismin=1
    2673       sxmin=sx(1)
    2674       do i=1,n-1
    2675          ix=ix+incx
    2676          if(sx(ix).lt.sxmin) then
    2677              sxmin=sx(ix)
    2678              ismin=i+1
    2679          endif
    2680       enddo
    2681 
    2682       return
    2683       end
    2684 
    2685 !===============================================================
    2686       function ismax(n,sx,incx)
    2687 
    2688       implicit none
    2689       integer n,i,incx,ismax,ix
    2690       real sx((n-1)*incx+1),sxmax
    2691 
    2692       ix=1
    2693       ismax=1
    2694       sxmax=sx(1)
    2695       do i=1,n-1
    2696          ix=ix+incx
    2697          if(sx(ix).gt.sxmax) then
    2698              sxmax=sx(ix)
    2699              ismax=i+1
    2700          endif
    2701       enddo
    2702 
    2703       return
    2704       end
    2705 
     2654

  • LMDZ5/branches/testing/libf/phy1d/1DUTILS.h_with_writelim_old

    r1707 r1795  
    125125       ok_flux_surf = .FALSE.
    126126       CALL getin('ok_flux_surf',ok_flux_surf)
     127
     128!Config  Key  = ok_old_disvert
     129!Config  Desc = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
     130!Config  Def  = false
     131!Config  Help = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
     132       ok_old_disvert = .FALSE.
     133       CALL getin('ok_old_disvert',ok_old_disvert)
    127134
    128135!Config  Key  = time_ini
    … …  
    703710      RETURN
    704711      END
    705       subroutine scopy(n,sx,incx,sy,incy)
    706 !
    707       IMPLICIT NONE
    708 !
    709       integer n,incx,incy,ix,iy,i
    710       real sx((n-1)*incx+1),sy((n-1)*incy+1)
    711 !
    712       iy=1
    713       ix=1
    714       do 10 i=1,n
    715          sy(iy)=sx(ix)
    716          ix=ix+incx
    717          iy=iy+incy
    718 10    continue
    719 !
    720       return
    721       end
    722712      subroutine wrgradsfi(if,nl,field,name,titlevar)
    723713      implicit none
    … …  
    10791069 
    10801070!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1081       SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
     1071      SUBROUTINE disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
    10821072 
    10831073!    Auteur :  P. Le Van .
    … …  
    26042594        end
    26052595
    2606 !===============================================================
    2607       function ismin(n,sx,incx)
    2608 
    2609       implicit none
    2610       integer n,i,incx,ismin,ix
    2611       real sx((n-1)*incx+1),sxmin
    2612 
    2613       ix=1
    2614       ismin=1
    2615       sxmin=sx(1)
    2616       do i=1,n-1
    2617          ix=ix+incx
    2618          if(sx(ix).lt.sxmin) then
    2619              sxmin=sx(ix)
    2620              ismin=i+1
    2621          endif
    2622       enddo
    2623 
    2624       return
    2625       end
    2626 
    2627 !===============================================================
    2628       function ismax(n,sx,incx)
    2629 
    2630       implicit none
    2631       integer n,i,incx,ismax,ix
    2632       real sx((n-1)*incx+1),sxmax
    2633 
    2634       ix=1
    2635       ismax=1
    2636       sxmax=sx(1)
    2637       do i=1,n-1
    2638          ix=ix+incx
    2639          if(sx(ix).gt.sxmax) then
    2640              sxmax=sx(ix)
    2641              ismax=i+1
    2642          endif
    2643       enddo
    2644 
    2645       return
    2646       end
    2647 
     2596

  • LMDZ5/branches/testing/libf/phy1d/1D_decl_cases.h

    r1665 r1795  
    8181        real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
    8282        real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
     83
     84
     85!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     86!Declarations specifiques au cas AMMA
     87        character*80 :: fich_amma
     88! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
     89        logical  :: fixe_disvert=.true.
     90        integer nlev_amma, nt_amma
     91!       parameter (nlev_amma=29, nt_amma=48)  ! Fleur, juillet 2012
     92        parameter (nlev_amma=36, nt_amma=48)  ! Romain, octobre 2012
     93!       parameter (nlev_amma=26, nt_amma=48)  ! Test MPL feverier 2013
     94        integer year_ini_amma, day_ini_amma, mth_ini_amma
     95        real heure_ini_amma
     96        real day_ju_ini_amma   ! Julian day of amma first day
     97        parameter (year_ini_amma=2006)
     98        parameter (mth_ini_amma=7)
     99        parameter (day_ini_amma=10)  ! 10 = 10Juil2006
     100        parameter (heure_ini_amma=0.) !0h en secondes
     101        real dt_amma
     102        parameter (dt_amma=1800.)
     103
     104!profils initiaux:
     105        real plev_amma(nlev_amma)
     106        real tv_amma(nlev_amma),rho_amma(nlev_amma)
     107        real thv_amma(nlev_amma)
     108       
     109        real z_amma(nlev_amma)
     110        real th_amma(nlev_amma),q_amma(nlev_amma)
     111        real u_amma(nlev_amma)
     112        real v_amma(nlev_amma)
     113
     114        real thvsurf_amma,tvsurf_amma,rhosurf_amma,thsurf
     115
     116        real th_ammai(nlev_amma),q_ammai(nlev_amma)
     117        real u_ammai(nlev_amma)
     118        real v_ammai(nlev_amma)
     119        real vitw_ammai(nlev_amma)
     120        real ht_ammai(nlev_amma)
     121        real hq_ammai(nlev_amma)
     122        real vt_ammai(nlev_amma)
     123        real vq_ammai(nlev_amma)
     124       
     125!forcings
     126        real ht_amma(nlev_amma,nt_amma)
     127        real hq_amma(nlev_amma,nt_amma)
     128        real vitw_amma(nlev_amma,nt_amma)
     129        real lat_amma(nt_amma),sens_amma(nt_amma)
     130
     131!champs interpoles
     132        real plev_profamma(nlev_amma),vitw_profamma(nlev_amma)
     133        real ht_profamma(nlev_amma)
     134        real hq_profamma(nlev_amma)
     135        real lat_profamma,sens_profamma
     136        real vt_profamma(nlev_amma)
     137        real vq_profamma(nlev_amma)
     138        real th_profamma(nlev_amma)
     139        real q_profamma(nlev_amma)
     140        real u_profamma(nlev_amma)
     141        real v_profamma(nlev_amma)
     142
     143!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     144!Declarations specifiques au cas FIRE
     145        character*80 :: fich_fire
     146        integer nlev_fire, nt_fire
     147        parameter (nlev_fire=120, nt_fire=1) 
     148        integer year_ini_fire, day_ini_fire, mth_ini_fire
     149        real heure_ini_fire
     150        real day_ju_ini_fire   ! Julian day of fire first day
     151        parameter (year_ini_fire=1987)
     152        parameter (mth_ini_fire=7)
     153        parameter (day_ini_fire=14)  ! 14 = 14Juil1987
     154        parameter (heure_ini_fire=0.) !0h en secondes
     155
     156!profils initiaux:
     157        real z_fire(nlev_fire)
     158        real thl_fire(nlev_fire),qt_fire(nlev_fire)
     159        real u_fire(nlev_fire), v_fire(nlev_fire)
     160        real tke_fire(nlev_fire)
     161       
     162!forcings
     163        real ugeo_fire(nlev_fire),vgeo_fire(nlev_fire)
     164        real wls_fire(nlev_fire),dqtdx_fire(nlev_fire)
     165        real dqtdy_fire(nlev_fire)
     166        real dqtdt_fire(nlev_fire),thl_rad_fire(nlev_fire)
     167         
     168        real ugeo_mod(llm),vgeo_mod(llm),wls_mod(llm)
     169        real dqtdx_mod(llm),dqtdy_mod(llm),dqtdt_mod(llm)
     170        real thl_rad_mod(llm)
    83171!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    84172! Declarations specifiques au cas GCSSold
    … …  
    127215        real sens_prof,flat_prof,fact
    128216!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    129 
     217! declarations specifiques au cas Sandu
     218        character*80 :: fich_sandu
     219!        integer nlev_prof
     220!        parameter (nlev_prof = 41)
     221        integer nlev_sandu, nt_sandu
     222        parameter (nlev_sandu=87, nt_sandu=13)
     223        integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
     224        real day_ju_ini_sandu                                ! Julian day of sandu case first day
     225        parameter (year_ini_sandu=2006)
     226        parameter (mth_ini_sandu=7)
     227        parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
     228        real dt_sandu, tau_sandu
     229        logical  :: trouve_700=.true.
     230        parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
     231!       parameter (tau_sandu=3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
     232!!
     233        integer it_sandu1, it_sandu2
     234        real time_sandu1,time_sandu2
     235
     236        real ts_sandu(nt_sandu)
     237! profs comme "profil sandu"
     238        real plev_profs(nlev_sandu)
     239        real t_profs(nlev_sandu),thl_profs(nlev_sandu)
     240        real q_profs(nlev_sandu)
     241        real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
     242        real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
     243
     244        real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
     245! pour relaxer u,v,thl et qt vers les profils initiaux au dessus de 700hPa
     246        real relax_u(llm),relax_v(llm),relax_thl(llm),relax_q(llm,2)
     247!vertical advection computation
     248        real d_t_z(llm), d_q_z(llm)
     249        real d_t_dyn_z(llm), d_q_dyn_z(llm)
     250        real zz(llm)
     251        real zfact
     252!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     253! Declarations specifiques au cas Astex
     254        character*80 :: fich_astex
     255        integer nlev_astex, nt_astex
     256        parameter (nlev_astex=34, nt_astex=49)
     257        integer year_ini_astex, day_ini_astex, mth_ini_astex
     258        real day_ju_ini_astex                                ! Julian day of astex case first day
     259        parameter (year_ini_astex=1992)
     260        parameter (mth_ini_astex=6)
     261        parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
     262        real dt_astex, tau_astex
     263        parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
     264        integer it_astex1, it_astex2
     265        real time_astex1,time_astex2
     266        real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
     267        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
     268        real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
     269! profa comme "profil astex"
     270        real plev_profa(nlev_astex)
     271        real t_profa(nlev_astex),thl_profa(nlev_astex)
     272        real qv_profa(nlev_astex),ql_profa(nlev_astex)
     273        real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
     274        real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
     275        real tke_profa(nlev_astex)
     276!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     277

  • LMDZ5/branches/testing/libf/phy1d/1D_interp_cases.h

    r1665 r1795  
    181181
    182182      endif ! forcing_twpice
     183
     184!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     185!---------------------------------------------------------------------
     186! Interpolation forcing AMMA
     187!---------------------------------------------------------------------
     188
     189       if (forcing_amma) then
     190
     191        print*,
     192     : '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',
     193     :    daytime,day1,(daytime-day1)*86400.,
     194     :    (daytime-day1)*86400/dt_amma
     195
     196! time interpolation using TOGA interpolation routine
     197        CALL interp_amma_time(daytime,day1,annee_ref
     198     i       ,year_ini_amma,day_ju_ini_amma,nt_amma,dt_amma,nlev_amma
     199     i       ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma
     200     o       ,vitw_profamma,ht_profamma,hq_profamma,lat_profamma
     201     :       ,sens_profamma)
     202
     203      print*,'apres interpolation temporelle AMMA'
     204
     205      do k=1,nlev_amma
     206         th_profamma(k)=0.
     207         q_profamma(k)=0.
     208         u_profamma(k)=0.
     209         v_profamma(k)=0.
     210         vt_profamma(k)=0.
     211         vq_profamma(k)=0.
     212       enddo
     213! vertical interpolation using TOGA interpolation routine:
     214!      write(*,*)'avant interp vert', t_proftwp
     215      CALL interp_toga_vertical(play,nlev_amma,plev_amma
     216     :         ,th_profamma,q_profamma,u_profamma,v_profamma
     217     :         ,vitw_profamma
     218     :         ,ht_profamma,vt_profamma,hq_profamma,vq_profamma
     219     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
     220     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
     221       write(*,*) 'Profil initial forcing AMMA interpole'
     222
     223
     224!calcul de l'advection verticale a partir du omega
     225cCalcul des gradients verticaux
     226cinitialisation
     227      do l=1,llm
     228      d_t_z(l)=0.
     229      d_q_z(l)=0.
     230      enddo
     231
     232      DO l=2,llm-1
     233       d_t_z(l)=(temp(l+1)-temp(l-1))
     234     &          /(play(l+1)-play(l-1))
     235       d_q_z(l)=(q(l+1,1)-q(l-1,1))
     236     &          /(play(l+1)-play(l-1))
     237      ENDDO
     238      d_t_z(1)=d_t_z(2)
     239      d_q_z(1)=d_q_z(2)
     240      d_t_z(llm)=d_t_z(llm-1)
     241      d_q_z(llm)=d_q_z(llm-1)
     242
     243
     244      do l = 1, llm
     245       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
     246       omega(l) = w_mod(l)*(-rg*rho(l))
     247       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     248       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     249!calcul de l'advection totale
     250!        d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-omega(l)*d_t_z(l)
     251!attention: on impose dth
     252        d_th_adv(l) = alpha*omega(l)/rcpd+
     253     &         ht_mod(l)*(play(l)/pzero)**rkappa-omega(l)*d_t_z(l)
     254!        d_th_adv(l) = 0.
     255!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
     256        d_q_adv(l,1) = hq_mod(l)-omega(l)*d_q_z(l)
     257!        d_q_adv(l,1) = 0.
     258!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
     259   
     260       dt_cooling(l) = 0.0
     261      enddo
     262
     263
     264!     ok_flux_surf=.false.
     265      fsens=-1.*sens_profamma
     266      flat=-1.*lat_profamma
     267
     268      endif ! forcing_amma
     269
    183270!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    184271!---------------------------------------------------------------------
    … …  
    254341      endif ! forcing_armcu
    255342!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    256 
     343!---------------------------------------------------------------------
     344! Interpolation forcing in time and onto model levels
     345!---------------------------------------------------------------------
     346      if (forcing_sandu) then
     347
     348        print*,
     349     : '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',
     350     :    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_sandu
     351
     352! time interpolation:
     353! ATTENTION, cet appel ne convient pas pour TOGA !!
     354! revoir 1DUTILS.h et les arguments
     355      CALL interp_sandu_time(daytime,day1,annee_ref
     356     i             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu
     357     i             ,nlev_sandu
     358     i             ,ts_sandu,ts_prof)
     359
     360        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
     361
     362! vertical interpolation:
     363      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs
     364     :         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs
     365     :         ,omega_profs,o3mmr_profs
     366     :         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod
     367     :         ,omega_mod,o3mmr_mod,mxcalc)
     368!calcul de l'advection verticale
     369cCalcul des gradients verticaux
     370cinitialisation
     371      d_t_z(:)=0.
     372      d_q_z(:)=0.
     373      d_t_dyn_z(:)=0.
     374      d_q_dyn_z(:)=0.
     375! schema centre
     376!     DO l=2,llm-1
     377!      d_t_z(l)=(temp(l+1)-temp(l-1))
     378!    &          /(play(l+1)-play(l-1))
     379!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
     380!    &          /(play(l+1)-play(l-1))
     381! schema amont
     382      DO l=2,llm-1
     383       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
     384       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
     385!     print *,'l temp2 temp0 play2 play0 omega_mod',
     386!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
     387      ENDDO
     388      d_t_z(1)=d_t_z(2)
     389      d_q_z(1)=d_q_z(2)
     390      d_t_z(llm)=d_t_z(llm-1)
     391      d_q_z(llm)=d_q_z(llm-1)
     392
     393!  calcul de l advection verticale
     394! Confusion w (m/s) et omega (Pa/s) !!
     395      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
     396      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
     397!     do l=1,llm
     398!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
     399!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
     400!     enddo
     401
     402
     403! large-scale forcing : pour le cas Sandu ces forcages sont la SST
     404! et une divergence constante -> profil de omega
     405      tsurf = ts_prof
     406      write(*,*) 'SST suivante: ',tsurf
     407      do l = 1, llm
     408       omega(l) = omega_mod(l)
     409       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     410
     411       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     412!
     413!      d_th_adv(l) = 0.0
     414!      d_q_adv(l,1) = 0.0
     415!CR:test advection=0
     416!calcul de l'advection verticale
     417        d_th_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
     418!        print*,'temp adv',l,-d_t_dyn_z(l)
     419        d_q_adv(l,1) = -d_q_dyn_z(l)
     420!        print*,'q adv',l,-d_q_dyn_z(l)
     421       dt_cooling(l) = 0.0
     422      enddo
     423      endif ! forcing_sandu
     424!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     425!---------------------------------------------------------------------
     426! Interpolation forcing in time and onto model levels
     427!---------------------------------------------------------------------
     428      if (forcing_astex) then
     429
     430        print*,
     431     : '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',
     432     :    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_astex
     433
     434! time interpolation:
     435! ATTENTION, cet appel ne convient pas pour TOGA !!
     436! revoir 1DUTILS.h et les arguments
     437      CALL interp_astex_time(daytime,day1,annee_ref
     438     i             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex
     439     i             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex
     440     i             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof
     441     i             ,ufa_prof,vfa_prof)
     442
     443        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
     444
     445! vertical interpolation:
     446      CALL interp_astex_vertical(play,nlev_astex,plev_profa
     447     :         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa
     448     :         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa
     449     :         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod
     450     :         ,tke_mod,o3mmr_mod,mxcalc)
     451!calcul de l'advection verticale
     452!Calcul des gradients verticaux
     453!initialisation
     454      d_t_z(:)=0.
     455      d_q_z(:)=0.
     456      d_t_dyn_z(:)=0.
     457      d_q_dyn_z(:)=0.
     458! schema centre
     459!     DO l=2,llm-1
     460!      d_t_z(l)=(temp(l+1)-temp(l-1))
     461!    &          /(play(l+1)-play(l-1))
     462!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
     463!    &          /(play(l+1)-play(l-1))
     464! schema amont
     465      DO l=2,llm-1
     466       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
     467       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
     468!     print *,'l temp2 temp0 play2 play0 omega_mod',
     469!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
     470      ENDDO
     471      d_t_z(1)=d_t_z(2)
     472      d_q_z(1)=d_q_z(2)
     473      d_t_z(llm)=d_t_z(llm-1)
     474      d_q_z(llm)=d_q_z(llm-1)
     475
     476!  calcul de l advection verticale
     477! Confusion w (m/s) et omega (Pa/s) !!
     478      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
     479      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
     480!     do l=1,llm
     481!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
     482!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
     483!     enddo
     484
     485
     486! large-scale forcing : pour le cas Astex ces forcages sont la SST
     487! la divergence,ug,vg,ufa,vfa
     488      tsurf = ts_prof
     489      write(*,*) 'SST suivante: ',tsurf
     490      do l = 1, llm
     491       omega(l) = w_mod(l)
     492       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     493
     494       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     495!
     496!      d_th_adv(l) = 0.0
     497!      d_q_adv(l,1) = 0.0
     498!CR:test advection=0
     499!calcul de l'advection verticale
     500        d_th_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
     501!        print*,'temp adv',l,-d_t_dyn_z(l)
     502        d_q_adv(l,1) = -d_q_dyn_z(l)
     503!        print*,'q adv',l,-d_q_dyn_z(l)
     504       dt_cooling(l) = 0.0
     505      enddo
     506      endif ! forcing_astex
     507!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     508

  • LMDZ5/branches/testing/libf/phy1d/1D_read_forc_cases.h

    r1665 r1795  
    44!----------------------------------------------------------------------
    55
    6       if (forcing_les .or. forcing_radconv .or. forcing_GCSSold ) then
    7 
     6      if (forcing_les .or. forcing_radconv
     7     :    .or. forcing_GCSSold .or. forcing_fire) then
     8
     9      if (forcing_fire) then
     10!----------------------------------------------------------------------
     11!read fire forcings from fire.nc
     12!----------------------------------------------------------------------
     13      fich_fire='fire.nc'
     14      call read_fire(fich_fire,nlev_fire,nt_fire
     15     :     ,height,tttprof,qtprof,uprof,vprof,e12prof
     16     :     ,ugprof,vgprof,wfls,dqtdxls
     17     :     ,dqtdyls,dqtdtls,thlpcar)
     18      write(*,*) 'Forcing FIRE lu'
     19      kmax=120            ! nombre de niveaux dans les profils et forcages
     20      else
    821!----------------------------------------------------------------------
    922! Read profiles from files: prof.inp.001 and lscale.inp.001
    … …  
    1629     .           wfls,dqtdxls,dqtdyls,dqtdtls,
    1730     .           thlpcar)
     31      endif
    1832
    1933! compute altitudes of play levels.
    … …  
    3549        frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
    3650        ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
    37         if (forcing_GCSSold .AND. tp_ini_GCSSold) then ! pot. temp. in initial profile
     51       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
    3852          temp(l) = ttt*(play(l)/pzero)**rkappa
    3953          teta(l) = ttt
    40         else
     54       else
    4155          temp(l) = ttt
    4256          teta(l) = ttt*(pzero/play(l))**rkappa
    43         endif
     57       endif
    4458          print *,' temp,teta ',l,temp(l),teta(l)
    4559        q(l,1)  = qtprof(kmax)-frac*( qtprof(kmax)- qtprof(kmax-1))
    … …  
    5872          if(zlay(l)>height(k-1).and.zlay(l)<height(k)) then
    5973            ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
    60         if (forcing_GCSSold .AND. tp_ini_GCSSold) then ! pot. temp. in initial profile
     74       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
    6175          temp(l) = ttt*(play(l)/pzero)**rkappa
    6276          teta(l) = ttt
    63         else
     77       else
    6478          temp(l) = ttt
    6579          teta(l) = ttt*(pzero/play(l))**rkappa
    66         endif
     80       endif
    6781          print *,' temp,teta ',l,temp(l),teta(l)
    6882            q(l,1)  = qtprof(k)-frac*( qtprof(k)- qtprof(k-1))
    … …  
    7791          elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
    7892            ttt =tttprof(1)
    79         if (forcing_GCSSold .AND. tp_ini_GCSSold) then ! pot. temp. in initial profile
     93       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
    8094          temp(l) = ttt*(play(l)/pzero)**rkappa
    8195          teta(l) = ttt
    82         else
     96       else
    8397          temp(l) = ttt
    8498          teta(l) = ttt*(pzero/play(l))**rkappa
    85         endif
     99       endif
    86100            q(l,1)  = qtprof(1)
    87101            u(l)    =  uprof(1)
    … …  
    112126      enddo
    113127
    114       endif ! forcing_les .or. forcing_GCSSold
     128      endif ! forcing_les .or. forcing_GCSSold .or. forcing_fire
    115129!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    116130!---------------------------------------------------------------------
    … …  
    263277       
    264278      endif !forcing_twpice
     279
     280!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     281!---------------------------------------------------------------------
     282! Forcing from AMMA experiment (Couvreux et al. 2010) :
     283!---------------------------------------------------------------------
     284
     285      if (forcing_amma) then
     286!read AMMA forcings
     287      fich_amma='amma.nc'
     288      call read_amma(fich_amma,nlev_amma,nt_amma
     289     :     ,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma
     290     :     ,ht_amma,hq_amma,sens_amma,lat_amma)
     291
     292      write(*,*) 'Forcing AMMA lu'
     293
     294!champs initiaux:
     295      do k=1,nlev_amma
     296         th_ammai(k)=th_amma(k)
     297         q_ammai(k)=q_amma(k)
     298         u_ammai(k)=u_amma(k)
     299         v_ammai(k)=v_amma(k)
     300         vitw_ammai(k)=vitw_amma(k,12)
     301         ht_ammai(k)=ht_amma(k,12)
     302         hq_ammai(k)=hq_amma(k,12)
     303         vt_ammai(k)=0.
     304         vq_ammai(k)=0.
     305      enddo   
     306      omega(:)=0.     
     307      omega2(:)=0.
     308      rho(:)=0.
     309! vertical interpolation using TOGA interpolation routine:
     310!      write(*,*)'avant interp vert', t_proftwp
     311      CALL interp_toga_vertical(play,nlev_amma,plev_amma
     312     :         ,th_ammai,q_ammai,u_ammai,v_ammai,vitw_ammai
     313     :         ,ht_ammai,vt_ammai,hq_ammai,vq_ammai
     314     :         ,t_mod,q_mod,u_mod,v_mod,w_mod
     315     :         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
     316!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
     317
     318! initial and boundary conditions :
     319!      tsurf = ts_proftwp
     320      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
     321      do l = 1, llm
     322! Ligne du dessous à decommenter si on lit theta au lieu de temp
     323!      temp(l) = t_mod(l)*(play(l)/pzero)**rkappa
     324       temp(l) = t_mod(l)
     325       q(l,1) = q_mod(l)
     326       q(l,2) = 0.0
     327!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
     328       u(l) = u_mod(l)
     329       v(l) = v_mod(l)
     330       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
     331       omega(l) = w_mod(l)*(-rg*rho(l))
     332       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     333
     334       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     335!on applique le forcage total au premier pas de temps
     336!attention: signe different de toga
     337       d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
     338!forcage en th
     339!       d_th_adv(l) = ht_mod(l)
     340       d_q_adv(l,1) = hq_mod(l)
     341       d_q_adv(l,2) = 0.0
     342       dt_cooling(l)=0.
     343      enddo     
     344       write(*,*) 'Profil initial forcing AMMA interpole temp39',
     345     &           temp(39)
     346     
     347
     348!     ok_flux_surf=.false.
     349      fsens=-1.*sens_amma(12)
     350      flat=-1.*lat_amma(12)
     351       
     352      endif !forcing_amma
     353
     354
    265355!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    266356!---------------------------------------------------------------------
    … …  
    366456      endif ! forcing_armcu
    367457!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    368 
     458!---------------------------------------------------------------------
     459! Forcing from transition case of Irina Sandu                 
     460!---------------------------------------------------------------------
     461
     462      if (forcing_sandu) then
     463       write(*,*) 'Avant lecture Forcing SANDU'
     464
     465! read sanduref forcing :
     466      fich_sandu = './ifa_sanduref.txt'
     467      CALL read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
     468
     469       write(*,*) 'Forcing SANDU lu'
     470
     471!----------------------------------------------------------------------
     472! Read profiles from file: prof.inp.001
     473!----------------------------------------------------------------------
     474
     475      call readprofile_sandu(nlev_max,kmax,height,plev_profs,t_profs,
     476     .           thl_profs,q_profs,u_profs,v_profs,
     477     .           w_profs,omega_profs,o3mmr_profs)
     478
     479! time interpolation for initial conditions:
     480      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
     481! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
     482! revoir 1DUTILS.h et les arguments
     483
     484      print *,'Avant interp_sandu_time'
     485      print *,'daytime=',daytime
     486      print *,'day1=',day1
     487      print *,'annee_ref=',annee_ref
     488      print *,'year_ini_sandu=',year_ini_sandu
     489      print *,'day_ju_ini_sandu=',day_ju_ini_sandu
     490      print *,'nt_sandu=',nt_sandu
     491      print *,'dt_sandu=',dt_sandu
     492      print *,'nlev_sandu=',nlev_sandu
     493      CALL interp_sandu_time(daytime,day1,annee_ref
     494     i             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu
     495     i             ,nlev_sandu
     496     i             ,ts_sandu,ts_prof)
     497
     498! vertical interpolation:
     499      print *,'Avant interp_vertical: nlev_sandu=',nlev_sandu
     500      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs
     501     :         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs
     502     :         ,omega_profs,o3mmr_profs
     503     :         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod
     504     :         ,omega_mod,o3mmr_mod,mxcalc)
     505       write(*,*) 'Profil initial forcing SANDU interpole'
     506
     507! initial and boundary conditions :
     508      tsurf = ts_prof
     509      write(*,*) 'SST initiale: ',tsurf
     510      do l = 1, llm
     511       temp(l) = t_mod(l)
     512       tetal(l)=thl_mod(l)
     513       q(l,1) = q_mod(l)
     514       q(l,2) = 0.0
     515       u(l) = u_mod(l)
     516       v(l) = v_mod(l)
     517       w(l) = w_mod(l)
     518       omega(l) = omega_mod(l)
     519       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     520!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
     521!?       omega2(l)=-rho(l)*omega(l)
     522       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     523!      d_th_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
     524!      d_q_adv(l,1) = vq_mod(l)
     525       d_th_adv(l) = alpha*omega(l)/rcpd
     526       d_q_adv(l,1) = 0.0
     527       d_q_adv(l,2) = 0.0
     528      enddo
     529
     530      endif ! forcing_sandu
     531!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     532!---------------------------------------------------------------------
     533! Forcing from Astex case
     534!---------------------------------------------------------------------
     535
     536      if (forcing_astex) then
     537       write(*,*) 'Avant lecture Forcing Astex'
     538
     539! read astex forcing :
     540      fich_astex = './ifa_astex.txt'
     541      CALL read_astex(fich_astex,nlev_astex,nt_astex,div_astex,ts_astex,
     542     :  ug_astex,vg_astex,ufa_astex,vfa_astex)
     543
     544       write(*,*) 'Forcing Astex lu'
     545
     546!----------------------------------------------------------------------
     547! Read profiles from file: prof.inp.001
     548!----------------------------------------------------------------------
     549
     550      call readprofile_astex(nlev_max,kmax,height,plev_profa,t_profa,
     551     .           thl_profa,qv_profa,ql_profa,qt_profa,u_profa,v_profa,
     552     .           w_profa,tke_profa,o3mmr_profa)
     553
     554! time interpolation for initial conditions:
     555      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
     556! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
     557! revoir 1DUTILS.h et les arguments
     558
     559      print *,'Avant interp_astex_time'
     560      print *,'daytime=',daytime
     561      print *,'day1=',day1
     562      print *,'annee_ref=',annee_ref
     563      print *,'year_ini_astex=',year_ini_astex
     564      print *,'day_ju_ini_astex=',day_ju_ini_astex
     565      print *,'nt_astex=',nt_astex
     566      print *,'dt_astex=',dt_astex
     567      print *,'nlev_astex=',nlev_astex
     568      CALL interp_astex_time(daytime,day1,annee_ref
     569     i             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex
     570     i             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex
     571     i             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof
     572     i             ,ufa_prof,vfa_prof)
     573
     574! vertical interpolation:
     575      print *,'Avant interp_vertical: nlev_astex=',nlev_astex
     576      CALL interp_astex_vertical(play,nlev_astex,plev_profa
     577     :         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa
     578     :         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa
     579     :         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod
     580     :         ,tke_mod,o3mmr_mod,mxcalc)
     581       write(*,*) 'Profil initial forcing Astex interpole'
     582
     583! initial and boundary conditions :
     584      tsurf = ts_prof
     585      write(*,*) 'SST initiale: ',tsurf
     586      do l = 1, llm
     587       temp(l) = t_mod(l)
     588       tetal(l)=thl_mod(l)
     589       q(l,1) = qv_mod(l)
     590       q(l,2) = ql_mod(l)
     591       u(l) = u_mod(l)
     592       v(l) = v_mod(l)
     593       w(l) = w_mod(l)
     594       omega(l) = w_mod(l)
     595!      omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     596!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
     597!      omega2(l)=-rho(l)*omega(l)
     598       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     599!      d_th_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
     600!      d_q_adv(l,1) = vq_mod(l)
     601       d_th_adv(l) = alpha*omega(l)/rcpd
     602       d_q_adv(l,1) = 0.0
     603       d_q_adv(l,2) = 0.0
     604      enddo
     605
     606      endif ! forcing_astex
     607

  • LMDZ5/branches/testing/libf/phy1d/compar1d.h

    r1665 r1795  
    2525
    2626      logical :: restart
     27      logical :: ok_old_disvert
    2728
    2829      common/com_par1d/forcing_type,nat_surf,tsurf,rugos,               &
    2930     & qsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,    &
    3031     & wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
    31      & restart
     32     & restart,ok_old_disvert
    3233
    3334!$OMP THREADPRIVATE(/com_par1d/)

  • LMDZ5/branches/testing/libf/phy1d/lmdz1d.F

    r1750 r1795  
    66      use dimphy
    77      use surface_data, only : type_ocean,ok_veget
    8       use pbl_surface_mod, only : pbl_surface_init, pbl_surface_final
     8      use pbl_surface_mod, only : ftsoil, pbl_surface_init,
     9     $                            pbl_surface_final
    910      use fonte_neige_mod, only : fonte_neige_init, fonte_neige_final
    1011
    1112      use infotrac ! new
    1213      use control_mod
     14      USE indice_sol_mod
    1315
    1416      implicit none
    … …  
    2022#include "clesphys.h"
    2123#include "dimsoil.h"
    22 #include "indicesol.h"
     24!#include "indicesol.h"
    2325
    2426#include "comvert.h"
    2527#include "compar1d.h"
    2628#include "flux_arp.h"
     29#include "tsoilnudge.h"
    2730#include "fcg_gcssold.h"
    2831!!!#include "fbforcing.h"
    … …  
    8689
    8790        integer :: kmax = llm
    88         integer nlev_max
    89         parameter (nlev_max = 100)
     91        integer nlev_max,llm700
     92        parameter (nlev_max = 1000)
    9093        real timestep, frac, timeit
    9194        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max),
    … …  
    98101c        integer :: forcing_type
    99102        logical :: forcing_les     = .false.
    100         logical :: forcing_armcu  = .false.
     103        logical :: forcing_armcu   = .false.
    101104        logical :: forcing_rico    = .false.
    102105        logical :: forcing_radconv = .false.
    103106        logical :: forcing_toga    = .false.
    104107        logical :: forcing_twpice  = .false.
     108        logical :: forcing_amma    = .false.
    105109        logical :: forcing_GCM2SCM = .false.
    106110        logical :: forcing_GCSSold = .false.
     111        logical :: forcing_sandu   = .false.
     112        logical :: forcing_astex   = .false.
     113        logical :: forcing_fire    = .false.
    107114        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
    108115!                                                            (cf read_tsurf1d.F)
    109116
    110117!vertical advection computation
    111         real d_t_z(llm), d_q_z(llm)
    112         real d_t_dyn_z(llm), d_q_dyn_z(llm)
    113         real zz(llm)
    114         real zfact
     118!       real d_t_z(llm), d_q_z(llm)
     119!       real d_t_dyn_z(llm), d_q_dyn_z(llm)
     120!       real zz(llm)
     121!       real zfact
    115122
    116123!flag forcings
    … …  
    129136      real :: pzero=1.e5
    130137      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
    131       real :: playd(llm),zlayd(llm)
     138      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1),poub
    132139
    133140!---------------------------------------------------------------------
    … …  
    137144      integer :: iq
    138145      real :: phi(llm)
    139       real :: teta(llm),temp(llm),u(llm),v(llm)
     146      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
     147      real :: rlat_rad(1),rlon_rad(1)
    140148      real :: omega(llm+1),omega2(llm),rho(llm+1)
    141149      real :: ug(llm),vg(llm),fcoriolis
     150      real :: sfdt, cfdt
    142151      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
    143152      real :: du_dyn(llm),dv_dyn(llm),dt_dyn(llm)
    … …  
    194203!  Fichiers et d'autres variables
    195204!---------------------------------------------------------------------
    196       real ttt
     205      real ttt,bow,q1
    197206      integer :: ierr,k,l,i,it=1,mxcalc
    198207      integer jjmp1
    … …  
    250259!             initial profiles from RICO files
    251260!             LS convergence imposed from RICO files
     261!forcing_type = 6 ==> forcing_amma = .true.
     262!             initial profiles from AMMA nc file
     263!             LS convergence, omega and surface fluxes imposed from AMMA file 
    252264!forcing_type = 40 ==> forcing_GCSSold = .true.
    253265!             initial profile from GCSS file
    254266!             LS convergence imposed from GCSS file
     267!forcing_type = 59 ==> forcing_sandu = .true.
     268!             initial profiles from sanduref file: see prof.inp.001
     269!             SST varying with time and divergence constante: see ifa_sanduref.txt file
     270!             Radiation has to be computed interactively
     271!forcing_type = 60 ==> forcing_astex = .true.
     272!             initial profiles from file: see prof.inp.001
     273!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
     274!             Radiation has to be computed interactively
    255275!forcing_type = 61 ==> forcing_armcu = .true.
    256 !             initial profile from arm_cu file
    257 !             LS convergence imposed from arm_cu file
     276!             initial profiles from file: see prof.inp.001
     277!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
     278!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
     279!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s
     280!             Radiation to be switched off
    258281!
    259282      if (forcing_type .eq.0) THEN
    … …  
    269292      elseif (forcing_type .eq.5) THEN
    270293       forcing_rico = .true.
     294      elseif (forcing_type .eq.6) THEN
     295       forcing_amma = .true.
    271296      elseif (forcing_type .eq.40) THEN
    272297       forcing_GCSSold = .true.
     298      elseif (forcing_type .eq.59) THEN
     299       forcing_sandu   = .true.
     300      elseif (forcing_type .eq.60) THEN
     301       forcing_astex   = .true.
    273302      elseif (forcing_type .eq.61) THEN
    274303       forcing_armcu = .true.
    … …  
    276305      else
    277306       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
    278        stop 'Forcing_type should be 0,1,2,3 or 40'
     307       stop 'Forcing_type should be 0,1,2,3,4,5,6 or 40,59,60,61'
    279308      ENDIF
    280309      print*,"forcing type=",forcing_type
    … …  
    286315
    287316        type_ts_forcing = 0
    288         if (forcing_toga) type_ts_forcing = 1
     317        if (forcing_toga .or. forcing_sandu .or. forcing_astex)
     318     :    type_ts_forcing = 1
    289319
    290320!---------------------------------------------------------------------
    … …  
    325355c Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
    326356      IF(forcing_type .EQ. 61) fnday=53100./86400.
     357c Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
     358      IF(forcing_type .EQ. 6) fnday=64800./86400.
    327359      annee_ref = anneeref
    328360      mois = 1
    … …  
    334366      day_ini = day
    335367      day_end = day_ini + nday
     368
     369      IF (forcing_type .eq.2) THEN
    336370! Convert the initial date of Toga-Coare to Julian day
    337371      call ymds2ju
    338372     $ (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
    339373
     374      ELSEIF (forcing_type .eq.4) THEN
    340375! Convert the initial date of TWPICE to Julian day
    341376      call ymds2ju
    342377     $ (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi
    343378     $ ,day_ju_ini_twpi)
    344 
    345 ! Convert the initial date of Arm_cu to Julian day
     379      ELSEIF (forcing_type .eq.6) THEN
     380! Convert the initial date of AMMA to Julian day
     381      call ymds2ju
     382     $ (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma
     383     $ ,day_ju_ini_amma)
     384
     385      ELSEIF (forcing_type .eq.59) THEN
     386! Convert the initial date of Sandu case to Julian day
     387      call ymds2ju
     388     $   (year_ini_sandu,mth_ini_sandu,day_ini_sandu,
     389     $    time_ini*3600.,day_ju_ini_sandu)
     390
     391      ELSEIF (forcing_type .eq.60) THEN
     392! Convert the initial date of Astex case to Julian day
     393      call ymds2ju
     394     $   (year_ini_astex,mth_ini_astex,day_ini_astex,
     395     $    time_ini*3600.,day_ju_ini_astex)
     396
     397      ELSEIF (forcing_type .eq.61) THEN
     398
     399! Convert the initial date of Arm_cu case to Julian day
    346400      call ymds2ju
    347401     $ (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu
    348402     $ ,day_ju_ini_armcu)
     403      ENDIF
    349404
    350405      daytime = day + time_ini/24. ! 1st day and initial time of the simulation
    … …  
    418473!!      preff= 1.01325e5
    419474      preff = psurf
    420       call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
     475      IF (ok_old_disvert) THEN
     476        call disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
     477        print *,'On utilise disvert0'
     478      ELSE
     479        call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,
     480     :                 scaleheight)
     481        print *,'On utilise disvert'
     482c       Nouvelle version disvert permettant d imposer ap,bp (modif L.Guez) MPL 18092012
     483c       Dans ce cas, on lit ap,bp dans le fichier hybrid.txt
     484      ENDIF
    421485      sig_s=presnivs/preff
    422486      plev =ap+bp*psurf
    … …  
    424488ccc      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
    425489
     490      IF (forcing_type .eq. 59) THEN
     491! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
    426492      write(*,*) '***********************'
    427493      do l = 1, llm
    428494       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
     495       if (trouve_700 .and. play(l).le.70000) then
     496         llm700=l
     497         print *,'llm700,play=',llm700,play(l)/100.
     498         trouve_700= .false.
     499       endif
    429500      enddo
    430501      write(*,*) '***********************'
     502      ENDIF
    431503
    432504c
    … …  
    460532! rday: defini dans suphel.F (86400.)
    461533! day_ini: lu dans run.def (dayref)
    462 ! rlat,rlon lus dans lmdz1d.def
     534! rlat_rad,rlon-rad: transformes en radian de rlat,rlon lus dans lmdz1d.def (en degres)
    463535! airefi,zcufi,zcvfi initialises au debut de ce programme
    464536! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
    … …  
    470542      zcufi=airefi
    471543      zcvfi=airefi
     544!
     545      rlat_rad(:)=rlat(:)*rpi/180.
     546      rlon_rad(:)=rlon(:)*rpi/180.
    472547
    473548      call iniphysiq(ngrid,llm,rday,day_ini,timestep,
    474      .     rlat,rlon,airefi,zcufi,zcvfi,ra,rg,rd,rcpd,1)
     549     .     rlat_rad,rlon_rad,airefi,zcufi,zcvfi,ra,rg,rd,rcpd,(/1/))
    475550      print*,'apres iniphysiq'
    476551
    … …  
    501576        agesno  = xagesno
    502577        tsoil(:,:,:)=tsurf
     578!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
     579!       tsoil(1,1,1)=299.18
     580!       tsoil(1,2,1)=300.08
     581!       tsoil(1,3,1)=301.88
     582!       tsoil(1,4,1)=305.48
     583!       tsoil(1,5,1)=308.00
     584!       tsoil(1,6,1)=308.00
     585!       tsoil(1,7,1)=308.00
     586!       tsoil(1,8,1)=308.00
     587!       tsoil(1,9,1)=308.00
     588!       tsoil(1,10,1)=308.00
     589!       tsoil(1,11,1)=308.00
     590!-----------------------------------------------------------------------
    503591        call pbl_surface_init(qsol, fder, snsrf, qsurfsrf,
    504592     &                                    evap, frugs, agesno, tsoil)
    … …  
    734822       endif
    735823
    736        if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice) then
     824       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice
     825     :    .or.forcing_amma) then
    737826         fcoriolis=0.0 ; ug=0. ; vg=0.
    738827       endif
    … …  
    748837     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
    749838
     839!!!!!!!!!!!!!!!!!!!!!!!!
     840! Geostrophic wind
     841!!!!!!!!!!!!!!!!!!!!!!!!
     842       sfdt = sin(0.5*fcoriolis*timestep)
     843       cfdt = cos(0.5*fcoriolis*timestep)
     844!
     845        du_age(1:mxcalc)= -2.*sfdt/timestep*
     846     :          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -
     847     :           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
     848!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
     849!
     850       dv_age(1:mxcalc)= -2.*sfdt/timestep*
     851     :          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +
     852     :           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
     853!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
     854!
     855!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     856!         call  writefield_phy('dv_age' ,dv_age,llm)
     857!         call  writefield_phy('du_age' ,du_age,llm)
     858!         call  writefield_phy('du_phys' ,du_phys,llm)
     859!         call  writefield_phy('u_tend' ,u,llm)
     860!         call  writefield_phy('u_g' ,ug,llm)
     861!
     862!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     863!! Increment state variables
     864!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    750865        u(1:mxcalc)=u(1:mxcalc) + timestep*(
    751866     :              du_phys(1:mxcalc)
    … …  
    773888
    774889        teta=temp*(pzero/play)**rkappa
     890!
     891!---------------------------------------------------------------------
     892!   Nudge soil temperature if requested
     893!---------------------------------------------------------------------
     894
     895      IF (nudge_tsoil) THEN
     896       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)
     897     .  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
     898      ENDIF
    775899
    776900!---------------------------------------------------------------------

  • LMDZ5/branches/testing/libf/phy1d/ocean_forced_mod.F90

    r1665 r1795  
    3131    USE limit_read_mod
    3232    USE mod_grid_phy_lmdz
    33     INCLUDE "indicesol.h"
     33    USE indice_sol_mod
     34!    INCLUDE "indicesol.h"
    3435    INCLUDE "YOMCST.h"
    3536
    … …  
    145146    USE limit_read_mod
    146147    USE fonte_neige_mod,  ONLY : fonte_neige
    147 
    148     INCLUDE "indicesol.h"
     148    USE indice_sol_mod
     149
     150!    INCLUDE "indicesol.h"
    149151    INCLUDE "dimsoil.h"
    150152    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phy1d/surf_land_bucket_mod.F90

    r1665 r1795  
    2626    USE mod_grid_phy_lmdz
    2727    USE mod_phys_lmdz_para
     28    USE indice_sol_mod
    2829!****************************************************************************************
    2930! Bucket calculations for surface.
    3031!
    3132    INCLUDE "clesphys.h"
    32     INCLUDE "indicesol.h"
     33!    INCLUDE "indicesol.h"
    3334    INCLUDE "dimsoil.h"
    3435    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phydev/physiq.F90

    r1707 r1795  
    7575integer,save :: iwrite_phys ! output every iwrite_phys physics step
    7676!$OMP THREADPRIVATE(iwrite_phys)
     77integer :: iwrite_phys_omp ! intermediate variable to read iwrite_phys
    7778real :: t_ops ! frequency of the IOIPSL operations (eg average over...)
    7879real :: t_wrt ! frequency of the IOIPSL outputs
    … …  
    8687! Initialize outputs:
    8788  itau0=0
    88   iwrite_phys=1 !default: output every physics timestep
    89   call getin("iwrite_phys",iwrite_phys)
     89!$OMP MASTER
     90  iwrite_phys_omp=1 !default: output every physics timestep
     91  ! NB: getin() is not threadsafe; only one thread should call it.
     92  call getin("iwrite_phys",iwrite_phys_omp)
     93!$OMP END MASTER
     94!$OMP BARRIER
     95  iwrite_phys=iwrite_phys_omp
    9096  t_ops=pdtphys*iwrite_phys ! frequency of the IOIPSL operation
    9197  t_wrt=pdtphys*iwrite_phys ! frequency of the outputs in the file

  • LMDZ5/branches/testing/libf/phylmd/aero_mod.F90

    r1279 r1795  
    55
    66  ! Total number of aerosols
    7   INTEGER, PARAMETER :: naero_tot = 10
     7!  INTEGER, PARAMETER :: naero_tot = 10
     8!--STRAT AER
     9  INTEGER, PARAMETER :: naero_tot = 11
    810
    911  ! Identification number used in aeropt_2bands and aeropt_5wv
    … …  
    1921  INTEGER, PARAMETER :: id_AIBCM    = 9
    2022  INTEGER, PARAMETER :: id_AIPOMM   = 10
     23!--STRAT AER
     24  INTEGER, PARAMETER :: id_strat   = 11
     25
    2126
    2227  ! Total number of aerosols actually used in LMDZ
    … …  
    3136  ! 9 =  AIBCM
    3237  !10 =  AIPOMM
    33   INTEGER, PARAMETER :: naero_spc = 10
     38!--STRAT AER
     39  !11 = aerosols stratos
     40!  INTEGER, PARAMETER :: naero_spc = 10
     41  INTEGER, PARAMETER :: naero_spc = 11
    3442
    3543  ! Corresponding names for the aerosols
    36   CHARACTER(len=7),DIMENSION(naero_spc) :: name_aero=(/&
     44  CHARACTER(len=7),DIMENSION(naero_spc), PARAMETER :: name_aero=(/&
    3745       "ASBCM  ", &
    3846       "ASPOMM ", &
    … …  
    4452       "CIDUSTM", &
    4553       "AIBCM  ", &
    46        "AIPOMM " /)
     54!       "AIPOMM " /)
     55       "AIPOMM ", &
     56       "STRAT  " /)
    4757
    4858
    … …  
    6575  INTEGER, parameter :: nbands = 2
    6676
    67 
    6877END MODULE aero_mod

  • LMDZ5/branches/testing/libf/phylmd/calbeta.F90

    r793 r1795  
    66
    77  USE dimphy
     8  USE indice_sol_mod
    89  IMPLICIT none
    910!======================================================================
    … …  
    1314!
    1415! Calculer quelques parametres pour appliquer la couche limite
    15 ! ------------------------------------------------------------
    16   INCLUDE "indicesol.h"
    17  
     16! ------------------------------------------------------------
    1817! Variables d'entrees
    1918!****************************************************************************************

  • LMDZ5/branches/testing/libf/phylmd/calcul_fluxs_mod.F90

    r1107 r1795  
    1212   
    1313    USE dimphy, ONLY : klon
     14    USE indice_sol_mod
    1415
    1516! Cette routine calcule les fluxs en h et q a l'interface et eventuellement
    … …  
    4950    INCLUDE "YOETHF.h"
    5051    INCLUDE "FCTTRE.h"
    51     INCLUDE "indicesol.h"
    5252    INCLUDE "YOMCST.h"
    5353

  • LMDZ5/branches/testing/libf/phylmd/calltherm.F90

    r1750 r1795  
    1717     &      ,alp_bl_conv,alp_bl_stat &
    1818!!! fin nrlmd le 10/04/2012
    19      &                    )
     19     &      ,zqla,ztva )
    2020
    2121      USE dimphy
     22      USE indice_sol_mod
     23
    2224      implicit none
    2325#include "dimensions.h"
    … …  
    2628#include "iniprint.h"
    2729
    28 !!! nrlmd le 10/04/2012
    29 #include "indicesol.h"
    30 !!! fin nrlmd le 10/04/2012
    3130
    3231!IM 140508
    33       INTEGER itap
     32      INTEGER, SAVE ::  itap
     33!$OMP THREADPRIVATE(itap)
    3434      REAL dtime
    3535      LOGICAL debut
    … …  
    6262      real zqla(klon,klev)
    6363      real zqta(klon,klev)
    64       real ztv(klon,klev)
     64      real ztv(klon,klev),ztva(klon,klev)
    6565      real zpspsk(klon,klev)
    6666      real ztla(klon,klev)
    … …  
    256256     &      ,alp_bl_conv,alp_bl_stat &
    257257!!! fin nrlmd le 10/04/2012
    258      &                         )
     258     &      ,ztva )
    259259           if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK'
    260260         else

  • LMDZ5/branches/testing/libf/phylmd/carbon_cycle_mod.F90

    r1454 r1795  
    1919!$OMP THREADPRIVATE(carbon_cycle_cpl)
    2020
     21  LOGICAL :: carbon_cycle_emis_comp_omp=.FALSE.
    2122  LOGICAL :: carbon_cycle_emis_comp=.FALSE. ! Calculation of emission compatible
    2223!$OMP THREADPRIVATE(carbon_cycle_emis_comp)
    2324
     25  LOGICAL :: RCO2_inter_omp
    2426  LOGICAL :: RCO2_inter  ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme
    2527!$OMP THREADPRIVATE(RCO2_inter)
    2628
    2729! Scalare values when no transport, from physiq.def
     30  REAL :: fos_fuel_s_omp
    2831  REAL :: fos_fuel_s  ! carbon_cycle_fos_fuel dans physiq.def
    2932!$OMP THREADPRIVATE(fos_fuel_s)
    … …  
    112115    ! Read fosil fuel value if no transport
    113116    IF (.NOT. carbon_cycle_tr) THEN
    114        fos_fuel_s = 0.
    115        CALL getin ('carbon_cycle_fos_fuel',fos_fuel_s)
     117!$OMP MASTER
     118       fos_fuel_s_omp = 0.
     119       CALL getin ('carbon_cycle_fos_fuel',fos_fuel_s_omp)
     120!$OMP END MASTER
     121!$OMP BARRIER
     122       fos_fuel_s=fos_fuel_s_omp
    116123       WRITE(lunout,*) 'carbon_cycle_fos_fuel = ', fos_fuel_s
    117124    END IF
    … …  
    120127    ! Read parmeter for calculation compatible emission
    121128    IF (.NOT. carbon_cycle_tr) THEN
    122        carbon_cycle_emis_comp=.FALSE.
    123        CALL getin('carbon_cycle_emis_comp',carbon_cycle_emis_comp)
     129!$OMP MASTER
     130       carbon_cycle_emis_comp_omp=.FALSE.
     131       CALL getin('carbon_cycle_emis_comp',carbon_cycle_emis_comp_omp)
     132!$OMP END MASTER
     133!$OMP BARRIER
     134       carbon_cycle_emis_comp=carbon_cycle_emis_comp_omp
    124135       WRITE(lunout,*) 'carbon_cycle_emis_comp = ',carbon_cycle_emis_comp
    125136       IF (carbon_cycle_emis_comp) THEN
    … …  
    129140
    130141    ! Read parameter for interactive calculation of the CO2 value for the radiation scheme
    131     RCO2_inter=.FALSE.
    132     CALL getin('RCO2_inter',RCO2_inter)
     142!$OMP MASTER
     143    RCO2_inter_omp=.FALSE.
     144    CALL getin('RCO2_inter',RCO2_inter_omp)
     145!$OMP END MASTER
     146!$OMP BARRIER
     147    RCO2_inter=RCO2_inter_omp
    133148    WRITE(lunout,*) 'RCO2_inter = ', RCO2_inter
    134149    IF (RCO2_inter) THEN
    … …  
    294309    USE phys_cal_mod, ONLY : day_cur
    295310    USE comgeomphy
     311    USE indice_sol_mod
    296312
    297313    IMPLICIT NONE
    298314
    299315    INCLUDE "clesphys.h"
    300     INCLUDE "indicesol.h"
    301316    INCLUDE "iniprint.h"
    302317    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phylmd/change_srf_frac_mod.F90

    r1707 r1795  
    2828    USE cpl_mod, ONLY : cpl_receive_frac
    2929    USE ocean_slab_mod, ONLY : ocean_slab_frac
     30    USE indice_sol_mod
    3031
    3132    INCLUDE "iniprint.h"
    32     INCLUDE "indicesol.h"
    3333    INCLUDE "YOMCST.h"
    3434

  • LMDZ5/branches/testing/libf/phylmd/clcdrag.F90

    r1279 r1795  
    88
    99  USE dimphy
     10  USE indice_sol_mod
     11
    1012  IMPLICIT NONE
    1113! ================================================================= c
    … …  
    1719!
    1820! knon----input-I- nombre de points pour un type de surface
    19 ! nsrf----input-I- indice pour le type de surface; voir indicesol.h
     21! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    2022! u1-------input-R- vent zonal au 1er niveau du modele
    2123! v1-------input-R- vent meridien au 1er niveau du modele
    … …  
    4143  INCLUDE "YOMCST.h"
    4244  INCLUDE "YOETHF.h"
    43   INCLUDE "indicesol.h"
    4445  INCLUDE "clesphys.h"
    4546!

  • LMDZ5/branches/testing/libf/phylmd/clesphys.h

    r1750 r1795  
    1212       LOGICAL cycle_diurne,soil_model,new_oliq,ok_orodr,ok_orolf
    1313       LOGICAL ok_limitvrai
    14        INTEGER nbapp_rad, iflag_con
     14       INTEGER nbapp_rad, iflag_con,iflag_ener_conserv
    1515       REAL co2_ppm, co2_ppm0, solaire
    1616       REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12 
    … …  
    7979       COMMON/clesphys/cycle_diurne, soil_model, new_oliq,              &
    8080     &     ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, iflag_con       &
     81     &     , iflag_ener_conserv                                         &
    8182     &     , co2_ppm, solaire                                           &
    8283     &     , RCO2, RCH4, RN2O, RCFC11, RCFC12                           &

  • LMDZ5/branches/testing/libf/phylmd/cltracrn.F90

    r1409 r1795  
    99  USE dimphy
    1010  USE traclmdz_mod, ONLY : id_rn, id_pb
     11  USE indice_sol_mod
     12
    1113  IMPLICIT NONE
    1214!======================================================================
    … …  
    4446!======================================================================
    4547  include "YOMCST.h"
    46   include "indicesol.h"
    4748!
    4849!Entrees

  • LMDZ5/branches/testing/libf/phylmd/coef_diff_turb_mod.F90

    r1750 r1795  
    1717 
    1818    USE dimphy
     19    USE indice_sol_mod
    1920!
    2021! Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the
    … …  
    5556!****************************************************************************************
    5657    INCLUDE "clesphys.h"
    57     INCLUDE "indicesol.h"
    5858    INCLUDE "iniprint.h"
    5959    INCLUDE "compbl.h"
    … …  
    158158         
    159159!   iflag_pbl peut etre utilise comme longuer de melange
    160        IF (iflag_pbl.GE.18) THEN
     160       IF (iflag_pbl.GE.31) THEN
    161161          CALL vdif_kcay(knon,dtime,RG,RD,ypaprs,yt, &
    162162               yzlev,yzlay,yu,yv,yteta, &
    163163               ycdragm,yq2,q2diag,ykmm,ykmn,yustar, &
    164164               iflag_pbl)
    165        ELSE
     165       ELSE IF (iflag_pbl<20) THEN
    166166          CALL yamada4(knon,dtime,RG,RD,ypaprs,yt, &
    167167               yzlev,yzlay,yu,yv,yteta, &
    … …  
    187187   
    188188    USE dimphy
     189    USE indice_sol_mod
    189190 
    190191!======================================================================
    … …  
    211212    INCLUDE "FCTTRE.h"
    212213    INCLUDE "iniprint.h"
    213     INCLUDE "indicesol.h"
    214214    INCLUDE "compbl.h"
    215215    INCLUDE "YOMCST.h"
    … …  
    479479
    480480    USE dimphy
     481    USE indice_sol_mod
    481482
    482483!======================================================================
    … …  
    523524    REAL zdthmin(knon), zdthdp
    524525
    525     INCLUDE "indicesol.h"
    526526    INCLUDE "YOMCST.h"
    527527!

  • LMDZ5/branches/testing/libf/phylmd/coefcdrag.F90

    r1061 r1795  
    66                            ts, qsurf, rugos, okri, ri1, &
    77                            cdram, cdrah, cdran, zri1, pref)
     8
     9      USE indice_sol_mod
     10
    811      IMPLICIT none
    912!-------------------------------------------------------------------------
    … …  
    1821! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    1922! knon----input-I- nombre de points pour un type de surface
    20 ! nsrf----input-I- indice pour le type de surface; voir indicesol.h
     23! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    2124! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
    2225! speed---input-R- module du vent au 1er niveau du modele
    … …  
    4952      include "YOMCST.h"
    5053      include "YOETHF.h"
    51       include "indicesol.h"
    5254! Quelques constantes :
    5355      REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0, cepdu2=(0.1)**2

  • LMDZ5/branches/testing/libf/phylmd/concvl.F

    r1750 r1795  
    387387     $              dd_t,dd_q,Plim1,Plim2,asupmax,supmax0,
    388388     $              asupmaxmin,lalim_conv,
    389 !AC!+!RomP
    390      $              da,phi,mp,phi2,d1a,dam,sij,clw,  ! RomP
    391      $              elij,evap,ep,wdtrainA,wdtrainM)  ! RomP
    392 !AC!+!RomP
     389!AC!+!RomP+jyg
     390     $              da,phi,mp,phi2,d1a,dam,sij,clw,elij,       ! RomP
     391     $              evap,ep,epmlmMm,eplaMm,                    ! RomP
     392     $              wdtrainA,wdtrainM)                         ! RomP
     393!AC!+!RomP+jyg
    393394      endif 
    394395C------------------------------------------------------------------

  • LMDZ5/branches/testing/libf/phylmd/condsurf.F

    r776 r1795  
    55      USE mod_grid_phy_lmdz
    66      USE mod_phys_lmdz_para
     7      USE indice_sol_mod
    78      IMPLICIT none
    89c
    … …  
    2526cym#include "dimensions.h"
    2627cym#include "dimphy.h"
    27 #include "indicesol.h"
    2828#include "temps.h"
    2929#include "clesphys.h"

  • LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90

    r1750 r1795  
    1818                       iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
    1919                       ok_ade, ok_aie, ok_cdnc, aerosol_couple, &
    20                        flag_aerosol, new_aod, &
     20                       flag_aerosol, flag_aerosol_strat, new_aod, &
    2121                       bl95_b0, bl95_b1,&
    2222                       read_climoz, &
    … …  
    6060! ok_ade, ok_aie: apply or not aerosol direct and indirect effects
    6161! ok_cdnc, ok cloud droplet number concentration
     62! flag_aerosol_strat : flag pour les aerosols stratos
    6263! bl95_b*: parameters in the formula to link CDNC to aerosol mass conc
    6364!
    … …  
    7273  LOGICAL              :: ok_ade, ok_aie, ok_cdnc, aerosol_couple
    7374  INTEGER              :: flag_aerosol
     75  LOGICAL              :: flag_aerosol_strat
    7476  LOGICAL              :: new_aod
    7577  REAL                 :: bl95_b0, bl95_b1
    … …  
    8789  LOGICAL,SAVE        :: ok_ade_omp, ok_aie_omp, ok_cdnc_omp, aerosol_couple_omp
    8890  INTEGER, SAVE       :: flag_aerosol_omp
     91  LOGICAL, SAVE       :: flag_aerosol_strat_omp
    8992  LOGICAL, SAVE       :: new_aod_omp
    9093  REAL,SAVE           :: bl95_b0_omp, bl95_b1_omp
    … …  
    169172  LOGICAL,SAVE :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
    170173  INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
     174  INTEGER, SAVE :: iflag_ener_conserv_omp
    171175  LOGICAL,SAVE :: ok_strato_omp
    172176  LOGICAL,SAVE :: ok_hines_omp
    … …  
    306310  flag_aerosol_omp = 0
    307311  CALL getin('flag_aerosol',flag_aerosol_omp)
     312!
     313!Config Key  = flag_aerosol_strat
     314!Config Desc = use stratospheric aerosols T/F
     315!Config Def  = false
     316!Config Help = Used in physiq.F
     317!
     318!
     319  flag_aerosol_strat_omp = .false.
     320  CALL getin('flag_aerosol_strat',flag_aerosol_strat_omp)
    308321
    309322! Temporary variable for testing purpose!!
    … …  
    653666       CALL getin('iflag_con',iflag_con_omp)
    654667
     668!Config  Key  = iflag_ener_conserv
     669!Config  Desc = Flag de convection
     670!Config  Def  = 1
     671!Config  Help = Flag  pour la convection les options suivantes existent :
     672!Config         -1 pour Kinetic energy correction
     673!Config         1  conservation kinetic and enthalpy
     674       iflag_ener_conserv_omp = -1
     675       CALL getin('iflag_ener_conserv',iflag_ener_conserv_omp)
     676
     677!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    655678!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    656679!!
    … …  
    16371660    nbapp_rad = nbapp_rad_omp
    16381661    iflag_con = iflag_con_omp
     1662    iflag_ener_conserv = iflag_ener_conserv_omp
    16391663
    16401664    epmax = epmax_omp
    … …  
    17051729    aerosol_couple = aerosol_couple_omp
    17061730    flag_aerosol=flag_aerosol_omp
     1731    flag_aerosol_strat=flag_aerosol_strat_omp
    17071732    new_aod=new_aod_omp
    17081733    aer_type = aer_type_omp
    … …  
    18451870  write(lunout,*)'nbapp_rad=',nbapp_rad
    18461871  write(lunout,*)'iflag_con=',iflag_con
     1872  write(lunout,*)'iflag_ener_conserv=',iflag_ener_conserv
    18471873  write(lunout,*)' epmax = ', epmax
    18481874  write(lunout,*)' ok_adj_ema = ', ok_adj_ema
    … …  
    18881914  write(lunout,*)' aerosol_couple = ', aerosol_couple
    18891915  write(lunout,*)' flag_aerosol = ', flag_aerosol
     1916  write(lunout,*)' flag_aerosol_strat = ', flag_aerosol_strat
    18901917  write(lunout,*)' new_aod = ', new_aod
    18911918  write(lunout,*)' aer_type = ',aer_type

  • LMDZ5/branches/testing/libf/phylmd/cpl_mod.F90

    r1665 r1795  
    101101    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
    102102    USE surface_data
     103    USE indice_sol_mod
    103104
    104105    INCLUDE "dimensions.h"
    105     INCLUDE "indicesol.h"
    106106    INCLUDE "temps.h"
    107107    INCLUDE "iniprint.h"
    … …  
    295295    USE phys_state_var_mod, ONLY : rlon, rlat
    296296    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
    297    
    298     INCLUDE "indicesol.h"
     297    USE indice_sol_mod
     298
    299299    INCLUDE "temps.h"
    300300    INCLUDE "iniprint.h"
    … …  
    424424!
    425425    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
    426     INCLUDE "indicesol.h"
     426    USE indice_sol_mod
    427427
    428428! Input arguments
    … …  
    541541!
    542542    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
    543     INCLUDE "indicesol.h"
     543    USE indice_sol_mod
    544544    INCLUDE "dimensions.h"
    545545
    … …  
    732732!
    733733    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
    734     INCLUDE "indicesol.h"
     734    USE indice_sol_mod
    735735    INCLUDE "dimensions.h"
    736736
    … …  
    10261026    USE surface_data
    10271027    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
     1028    USE indice_sol_mod
    10281029! Some includes
    10291030!*************************************************************************************
    1030     INCLUDE "indicesol.h"
    10311031    INCLUDE "temps.h"
    10321032    INCLUDE "dimensions.h"

  • LMDZ5/branches/testing/libf/phylmd/cv3_routines.F

    r1750 r1795  
    35613561      SUBROUTINE cv3_tracer(nloc,len,ncum,nd,na,
    35623562     &                       ment,sigij,da,phi,phi2,d1a,dam,
    3563      &                       ep,Vprecip,elij,clw,icb,inb)
     3563     &                       ep,Vprecip,elij,clw,epmlmMm,eplaMm,
     3564     &                       icb,inb)
    35643565        implicit none
    35653566
    … …  
    35773578        real phi2(nloc,na,na)
    35783579        real d1a(nloc,na),dam(nloc,na)
     3580        real epmlmMm(nloc,na,na),eplaMm(nloc,na)
    35793581! variables pour tracer dans precip de l'AA et des mel
    35803582c local variables:
    … …  
    35953597       dam(:,:)=0.
    35963598       epm(:,:,:)=0.
    3597 c
    3598 !  fraction deau condensee dans les melanges convertie en precip
     3599       eplaMm(:,:)=0.
     3600       epmlmMm(:,:,:)=0.
     3601       phi(:,:,:)=0.
     3602       phi2(:,:,:)=0.
     3603c
     3604!  fraction deau condensee dans les melanges convertie en precip : epm
     3605! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz
    35993606        do j=1,na
    36003607         do k=1,na
    36013608           do i=1,ncum
    36023609            if(k.ge.icb(i).and.k.le.inb(i).and.
    3603      &         j.ge.k.and.j.le.inb(i)) then
    3604              epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
     3610!!jyg     &         j.ge.k.and.j.le.inb(i)) then
     3611!!jyg             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j)
     3612     &         j.gt.k.and.j.le.inb(i)) then
     3613             epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/
     3614     &                     max(elij(i,k,j),1.e-16)
     3615!!
    36053616             epm(i,j,k)=max(epm(i,j,k),0.0)
    36063617            endif
    … …  
    36083619         end do
    36093620        end do
     3621
     3622!
     3623        do j=1,na
     3624         do k=1,na
     3625           do i=1,ncum
     3626            if(k.ge.icb(i).and.k.le.inb(i)) then
     3627             eplaMm(i,j)=eplaMm(i,j) + ep(i,j)*clw(i,j)
     3628     &                  *ment(i,j,k)*(1.-sigij(i,j,k))
     3629            endif
     3630           end do
     3631         end do
     3632        end do
     3633!
     3634        do j=1,na
     3635         do k=1,j-1
     3636           do i=1,ncum
     3637            if(k.ge.icb(i).and.k.le.inb(i).and.
     3638     &         j.le.inb(i)) then
     3639             epmlmMm(i,j,k)=epm(i,j,k)*elij(i,k,j)*ment(i,k,j)
     3640            endif
     3641           end do
     3642         end do
     3643        end do
    36103644
    36113645!  matrices pour calculer la tendance des concentrations dans cvltr.F90
    … …  
    36223656
    36233657             phi2(i,j,k)=phi(i,j,k)*epm(i,j,k)   
    3624             else
    3625              dam(i,j)=0.
    3626              phi2(i,j,k)=0.
    36273658            endif
    36283659            end do

  • LMDZ5/branches/testing/libf/phylmd/cv3a_uncompress.F

    r1750 r1795  
    1010     :         ,asupmaxmin
    1111!
    12      :         ,da,phi                               !AC!
    13      :         ,mp,phi2,d1a,dam,sigij                  !RomP
    14      :         ,wdtrainA,wdtrainM,elij,clw           !RomP
    15      :         ,evap,ep                              !RomP
     12     :          ,da,phi,mp,phi2,d1a,dam,sigij         ! RomP+AC+jyg
     13     :          ,clw,elij,evap,ep,epmlmMm,eplaMm      ! RomP
     14     :          ,wdtrainA,wdtrainM                    ! RomP
    1615!
    1716     o         ,iflag1,kbas1,ktop1
    18      :         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
    19      :         ,ft1,fq1,fu1,fv1,ftra1
    20      :         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
    21      :         ,qcondc1,wd1,cape1,cin1
    22      :         ,tvp1
    23      :         ,ftd1,fqd1
    24      :         ,Plim11,Plim21,asupmax1,supmax01
    25      :         ,asupmaxmin1     
    26 !
    27      o         ,da1,phi1                             !AC!
    28      o         ,mp1,phi21,d1a1,dam1,sigij1             !RomP
    29      o         ,wdtrainA1,wdtrainM1,elij1,clw1       !RomP
    30      o         ,evap1,ep1)                           !RomP
     17     o         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
     18     o         ,ft1,fq1,fu1,fv1,ftra1
     19     o         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
     20     o         ,qcondc1,wd1,cape1,cin1
     21     o         ,tvp1
     22     o         ,ftd1,fqd1
     23     o         ,Plim11,Plim21,asupmax1,supmax01
     24     o         ,asupmaxmin1     
     25!
     26     o          ,da1,phi1,mp1,phi21,d1a1,dam1,sigij1  ! RomP+AC+jyg
     27     o          ,clw1,elij1,evap1,ep1,epmlmMm1,eplaMm1! RomP
     28     o          ,wdtrainA1,wdtrainM1)                 ! RomP
    3129!
    3230***************************************************************
    … …  
    6765      real phi2(nloc,nd,nd)                               !RomP
    6866      real d1a(nloc,nd),dam(nloc,nd)                      !RomP
     67      real sigij(nloc,nd,nd)                              !RomP
     68      real clw(nloc,nd),elij(nloc,nd,nd)                  !RomP
     69      real evap(nloc,nd),ep(nloc,nd)                      !RomP
     70      real epmlmMm(nloc,nd,nd),eplaMm(nloc,nd)            !RomP+jyg
    6971      real wdtrainA(nloc,nd), wdtrainM(nloc,nd)           !RomP
    70       real sigij(nloc,nd,nd)                                !RomP
    71       real elij(nloc,nd,nd),clw(nloc,nd)                  !RomP
    72       real evap(nloc,nd),ep(nloc,nd)                      !RomP
    7372!
    7473c outputs:
    … …  
    9493      real phi21(nloc,nd,nd)                              !RomP
    9594      real d1a1(nloc,nd),dam1(nloc,nd)                    !RomP
     95      real sigij1(len,nd,nd)                              !RomP
     96      real clw1(len,nd),elij1(len,nd,nd)                  !RomP
     97      real evap1(len,nd),ep1(len,nd)                      !RomP
     98      real epmlmMm1(len,nd,nd),eplaMm1(len,nd)            !RomP+jyg
    9699      real wdtrainA1(len,nd), wdtrainM1(len,nd)           !RomP
    97       real sigij1(len,nd,nd)                                !RomP
    98       real elij1(len,nd,nd),clw1(len,nd)                  !RomP
    99       real evap1(len,nd),ep1(len,nd)                      !RomP
    100100!
    101101c
    102102c local variables:
    103       integer i,k,j,k1,k2
     103      integer i,k,j
     104cc    integer k1,k2
    104105
    105106        do 2000 i=1,ncum
    … …  
    147148            d1a1(idcum(i),k)     = d1a(i,k)               !RomP
    148149            dam1(idcum(i),k)     = dam(i,k)               !RomP
    149             wdtrainA1(idcum(i),k)= wdtrainA(i,k)          !RomP
    150             wdtrainM1(idcum(i),k)= wdtrainM(i,k)          !RomP
    151150            clw1(idcum(i),k)     = clw(i,k)               !RomP
    152151            evap1(idcum(i),k)    = evap(i,k)              !RomP
    153152            ep1(idcum(i),k)      = ep(i,k)                !RomP
     153            eplaMm(idcum(i),k)   = eplaMm(i,k)            !RomP+jyg
     154            wdtrainA1(idcum(i),k)= wdtrainA(i,k)          !RomP
     155            wdtrainM1(idcum(i),k)= wdtrainM(i,k)          !RomP
    154156!
    155157 2010    continue
    … …  
    171173
    172174!AC!
    173        do k2=1,nd
    174          do k1=1,nd
     175       do j=1,nd
     176         do k=1,nd
    175177          do i=1,ncum
    176             phi1(idcum(i),k1,k2)=phi(i,k1,k2)                 !AC!
    177             phi21(idcum(i),k1,k2)= phi2(idcum(i),k1,k2)   !RomP
    178             sigij1(idcum(i),k1,k2) = sigij(idcum(i),k1,k2)    !RomP
    179             elij1(idcum(i),k1,k2)= elij(idcum(i),k1,k2)   !RomP
     178            phi1(idcum(i),k,j)   = phi(i,k,j)           !AC!
     179            phi21(idcum(i),k,j)  = phi2(i,k,j)          !RomP
     180            sigij1(idcum(i),k,j) = sigij(i,k,j)         !RomP
     181            elij1(idcum(i),k,j)  = elij(i,k,j)          !RomP
     182            epmlmMm(idcum(i),k,j)= epmlmMm(i,k,j)       !RomP+jyg
    180183          end do
    181184         end do

  • LMDZ5/branches/testing/libf/phylmd/cv_driver.F

    r1750 r1795  
    99     &                   icb1,inb1,
    1010     &                   delt,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1,
    11      &                   da1,phi1,mp1,phi21,d1a1,dam1,sij1,clw1,elij1,
    12      &                   evap1,ep1,epmlmMm1,eplaMm1,
    13      &                   wdtrainA1,wdtrainM1)
     11     &                   da1,phi1,mp1,phi21,d1a1,dam1,sij1,clw1,elij1,  ! RomP
     12     &                   evap1,ep1,epmlmMm1,eplaMm1,                    ! RomP
     13     &                   wdtrainA1,wdtrainM1)                           ! RomP
    1414C
    1515      USE dimphy
    … …  
    1818C.............................START PROLOGUE............................
    1919C
     20!
     21! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
     22! The "1" is removed for the corresponding compressed (local) variables.
     23!
    2024C PARAMETERS:
    2125C      Name            Type         Usage            Description
    … …  
    5458C      wd1           Real           Output       downdraft velocity scale for sfc fluxes
    5559C      cape1         Real           Output       CAPE
     60!   
     61!      wdtrainA1     Real           Output   precipitation detrained from adiabatic draught;
     62!                                                       used in tracer transport (cvltr)
     63!      wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
     64!                                                       used in tracer transport (cvltr)
     65!      da1           Real           Output   used in tracer transport (cvltr)
     66!      phi1          Real           Output   used in tracer transport (cvltr)
     67!      mp1           Real           Output   used in tracer transport (cvltr)
     68!   
     69!      phi21         Real           Output   used in tracer transport (cvltr)
     70!   
     71!      d1a1          Real           Output   used in tracer transport (cvltr)
     72!      dam1          Real           Output   used in tracer transport (cvltr)
     73!   
     74!      evap1         Real           Output
     75!      ep1           Real           Output
     76!      sij1        Real           Output
     77!      elij1         Real           Output
    5678C
    5779C S. Bony, Mar 2002:
    … …  
    119141      real epmlmMm1(len,nd,nd),eplaMm1(len,nd)
    120142! RomP <<<
    121 
    122 
     143!
     144!-------------------------------------------------------------------
     145!        Original Prologue by Kerry Emanuel.
    123146!-------------------------------------------------------------------
    124147! --- ARGUMENTS
    … …  
    291314      real ments(nloc,klev,klev), qents(nloc,klev,klev)
    292315      real sij(nloc,klev,klev), elij(nloc,klev,klev)
    293 ! RomP >>>
    294       real da(nloc,klev),phi(nloc,klev,klev),mp(nloc,klev)
    295       real epmlmMm(nloc,klev,klev),eplaMm(nloc,klev) 
    296       real phi2(nloc,klev,klev)
    297       real d1a(nloc,klev), dam(nloc,klev)
    298       real wdtrainA(nloc,klev),wdtrainM(nloc,klev)
    299       real sigd(nloc)
    300 ! RomP <<<
    301316      real qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
    302317      real wt(nloc,klev), water(nloc,klev), evap(nloc,klev)
    … …  
    312327      real qcondc(nloc,klev)  ! cld
    313328      real wd(nloc)           ! gust
     329!
     330! RomP >>>
     331      real da(nloc,klev),phi(nloc,klev,klev),mp(nloc,klev)
     332      real epmlmMm(nloc,klev,klev),eplaMm(nloc,klev) 
     333      real phi2(nloc,klev,klev)
     334      real d1a(nloc,klev), dam(nloc,klev)
     335      real wdtrainA(nloc,klev),wdtrainM(nloc,klev)
     336      real sigd(nloc)
     337! RomP <<<
    314338
    315339      nent(:,:)=0
    … …  
    380404        enddo
    381405      endif
     406
     407! RomP >>>
     408       wdtrainA1(:,:)  =0.
     409        wdtrainM1(:,:) =0.
     410       da1(:,:)        =0.
     411       phi1(:,:,:)     =0.
     412       epmlmMm1(:,:,:) =0.
     413       eplaMm1(:,:)    =0.
     414       mp1(:,:)        =0.
     415       evap1(:,:)      =0.
     416       ep1(:,:)        =0.
     417       sij1(:,:,:)     =0.
     418       elij1(:,:,:)    =0.
     419       phi21(:,:,:)    =0.
     420       d1a1(:,:)       =0.
     421       dam1(:,:)       =0.
     422! RomP <<<
    382423
    383424!--------------------------------------------------------------------
    … …  
    729770      return
    730771      end
    731 

  • LMDZ5/branches/testing/libf/phylmd/cva_driver.F

    r1750 r1795  
    2222     &                   ,lalim_conv,
    2323     &                   da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1,     ! RomP
    24      &                   elij1,evap1,ep1,                              ! RomP
     24     &                   elij1,evap1,ep1,epmlmMm1,eplaMm1,             ! RomP
    2525     &                   wdtrainA1,wdtrainM1)                          ! RomP
    2626***************************************************************
    … …  
    3939C.............................START PROLOGUE............................
    4040C
     41!
     42! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
     43! The "1" is removed for the corresponding compressed variables.
    4144C PARAMETERS:
    4245C      Name            Type         Usage            Description
    … …  
    99102C      supmax01      Real           Output
    100103C      asupmaxmin1   Real           Output
     104!
     105!      ftd1          Real           Output  Array of temperature tendency due to precipitations (K/s) of dimension ND,
     106!                                           defined at same grid levels as T, Q, QS and P.
     107!   
     108!      fqd1          Real           Output  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
     109!                                           of dimension ND, defined at same grid levels as T, Q, QS and P.
     110!   
     111!      wdtrainA1     Real           Output   precipitation detrained from adiabatic draught;
     112!                                                       used in tracer transport (cvltr)
     113!      wdtrainM1     Real           Output   precipitation detrained from mixed draughts;
     114!                                                       used in tracer transport (cvltr)
     115!      da1           Real           Output   used in tracer transport (cvltr)
     116!      phi1          Real           Output   used in tracer transport (cvltr)
     117!      mp1           Real           Output   used in tracer transport (cvltr)
     118!   
     119!      phi21         Real           Output   used in tracer transport (cvltr)
     120!   
     121!      d1a1          Real           Output   used in tracer transport (cvltr)
     122!      dam1          Real           Output   used in tracer transport (cvltr)
     123!   
     124!      epmlmMm1      Real           Output   used in tracer transport (cvltr)
     125!      eplaMm1       Real           Output   used in tracer transport (cvltr)
     126!
     127!      evap1         Real           Output
     128!      ep1           Real           Output
     129!      sigij1        Real           Output
     130!      elij1         Real           Output
     131
     132C
    101133C S. Bony, Mar 2002:
    102134C       * Several modules corresponding to different physical processes
    … …  
    188220! RomP >>>
    189221      real wdtrainA1(len,nd), wdtrainM1(len,nd)
    190       real wdtrainA(nloc,klev),wdtrainM(nloc,klev)
    191222      real da1(len,nd),phi1(len,nd,nd),mp1(len,nd)
    192       real da(len,nd),phi(len,nd,nd)
     223      real epmlmMm1(len,nd,nd),eplaMm1(len,nd)
    193224      real evap1(len,nd),ep1(len,nd)
    194225      real sigij1(len,nd,nd),elij1(len,nd,nd)
    195       real phi2(len,nd,nd)
    196       real d1a(len,nd), dam(len,nd)
    197226      real phi21(len,nd,nd)
    198227      real d1a1(len,nd), dam1(len,nd)
    199228! RomP <<<
     229!
     230!-------------------------------------------------------------------
     231!        Prolog by Kerry Emanuel.
    200232!-------------------------------------------------------------------
    201233! --- ARGUMENTS
    … …  
    320352!
    321353!  det:   Array of detrainment mass flux of dimension ND.
    322 !
    323 !  ftd:  Array of temperature tendency due to precipitations (K/s) of dimension ND,
    324 !        defined at same grid levels as T, Q, QS and P.
    325 !
    326 !  fqd:  Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
    327 !        of dimension ND, defined at same grid levels as T, Q, QS and P.
    328 !
    329354!-------------------------------------------------------------------
    330355c
    … …  
    446471      real wghti(nloc,nd)
    447472      real hnk(nloc),unk(nloc),vnk(nloc)
     473!
     474! RomP >>>
     475      real wdtrainA(nloc,klev),wdtrainM(nloc,klev)
     476      real da(len,nd),phi(len,nd,nd)
     477      real epmlmMm(nloc,klev,klev),eplaMm(nloc,klev) 
     478      real phi2(len,nd,nd)
     479      real d1a(len,nd), dam(len,nd)
     480! RomP <<<
     481!
    448482      logical, save :: first=.true.
    449483c$OMP THREADPRIVATE(first)
    … …  
    498532      nword4=len*nd*nd
    499533 
    500 !      call izilch(iflag1  ,nword1)
    501 !      call  zilch(iflag1  ,nword1)
    502       do i=1,len
    503          iflag1(i)=0
    504          ktop1(i)=0
    505          kbas1(i)=0
    506       enddo
    507       call  zilch(ft1     ,nword2)
    508       call  zilch(fq1     ,nword2)
    509       call  zilch(fu1     ,nword2)
    510       call  zilch(fv1     ,nword2)
    511       call  zilch(ftra1   ,nword3)
    512       call  zilch(precip1 ,nword1)
    513 !      call izilch(kbas1   ,nword1)
    514 !      call  zilch(kbas1   ,nword1)
    515 !      call izilch(ktop1   ,nword1)
    516 !      call  zilch(ktop1   ,nword1)
    517       call  zilch(cbmf1   ,nword1)
    518       call  zilch(ptop21  ,nword1)
    519       sigd1(:)=0.
    520       call  zilch(Ma1     ,nword2)
    521       call  zilch(mip1    ,nword2)
    522 !      call  zilch(Vprecip1,nword2)
    523       Vprecip1=0.
    524       call  zilch(upwd1   ,nword2)
    525       call  zilch(dnwd1   ,nword2)
    526       call  zilch(dnwd01  ,nword2)
    527       call  zilch(qcondc1 ,nword2)
    528 !test
    529 !      call  zilch(qcondc ,nword2)
    530       call  zilch(wd1     ,nword1)
    531       call  zilch(cape1   ,nword1)
    532       call  zilch(cin1    ,nword1)
    533       call  zilch(tvp1    ,nword2)
    534       call  zilch(ftd1    ,nword2)
    535       call  zilch(fqd1    ,nword2)
    536       call  zilch(Plim11  ,nword1)
    537       call  zilch(Plim21  ,nword1)
    538       call  zilch(asupmax1,nword2)
    539       call  zilch(supmax01,nword1)
    540       call  zilch(asupmaxmin1,nword1)
     534      iflag1(:)     = 0
     535      ktop1(:)      = 0
     536      kbas1(:)      = 0
     537      ft1(:,:)      = 0.0
     538      fq1(:,:)      = 0.0
     539      fu1(:,:)      = 0.0
     540      fv1(:,:)      = 0.0
     541      ftra1(:,:,:)  = 0.
     542      precip1(:)    = 0.
     543      cbmf1(:)      = 0.
     544      ptop21(:)     = 0.
     545      sigd1(:)      = 0.
     546      Ma1(:,:)      = 0.
     547      mip1(:,:)     = 0.
     548      Vprecip1(:,:) = 0.
     549      upwd1   (:,:) = 0.
     550      dnwd1   (:,:) = 0.
     551      dnwd01  (:,:) = 0.
     552      qcondc1 (:,:) = 0.
     553      wd1     (:)   = 0.
     554      cape1   (:)   = 0.
     555      cin1    (:)   = 0.
     556      tvp1    (:,:) = 0.
     557      ftd1    (:,:) = 0.
     558      fqd1    (:,:) = 0.
     559      Plim11  (:)   = 0.
     560      Plim21  (:)   = 0.
     561      asupmax1(:,:) = 0.
     562      supmax01(:)   = 0.
     563      asupmaxmin1(:)= 0.
    541564c
    542565      DO il = 1,len
    … …  
    552575      endif
    553576 
     577! RomP >>>
     578       wdtrainA1(:,:)  = 0.
     579       wdtrainM1(:,:)  = 0.
     580       da1(:,:)        = 0.
     581       phi1(:,:,:)     = 0.
     582       epmlmMm1(:,:,:) = 0.
     583       eplaMm1(:,:)    = 0.
     584       mp1(:,:)        = 0.
     585       evap1(:,:)      = 0.
     586       ep1(:,:)        = 0.
     587       sigij1(:,:,:)   = 0.
     588       elij1(:,:,:)    = 0.
     589       phi21(:,:,:)    = 0.
     590       d1a1(:,:)       = 0.
     591       dam1(:,:)       = 0.
     592! RomP <<<
    554593!---------------------------------------------------------------------
    555594! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
    … …  
    941980       CALL cv3_tracer(nloc,len,ncum,nd,nd,
    942981     :                  ment,sigij,da,phi,phi2,d1a,dam,
    943      :                  ep,Vprecip,elij,clw,icb,inb)
     982     :                  ep,Vprecip,elij,clw,epmlmMm,eplaMm,
     983     :                  icb,inb)
    944984!RomP <<<
    945985      endif
    … …  
    9641004     :          ,asupmaxmin
    9651005     :          ,da,phi,mp,phi2,d1a,dam,sigij         ! RomP
    966      :          ,wdtrainA,wdtrainM,elij,clw           ! RomP
    967      :          ,evap,ep                              ! RomP
     1006     :          ,clw,elij,evap,ep,epmlmMm,eplaMm      ! RomP
     1007     :          ,wdtrainA,wdtrainM                    ! RomP
    9681008     o          ,iflag1,kbas1,ktop1
    9691009     o          ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
    … …  
    9761016     o          ,asupmaxmin1
    9771017     o          ,da1,phi1,mp1,phi21,d1a1,dam1,sigij1  ! RomP
    978      o          ,wdtrainA1,wdtrainM1,elij1,clw1       ! RomP
    979      o          ,evap1,ep1)                           ! RomP
     1018     o          ,clw1,elij1,evap1,ep1,epmlmMm1,eplaMm1! RomP
     1019     o          ,wdtrainA1,wdtrainM1)                 ! RomP
    9801020      endif
    9811021

  • LMDZ5/branches/testing/libf/phylmd/cvltr.F90

    r1750 r1795  
    121121   coefcoli         = 0.
    122122
     123!$OMP MASTER
    123124  call getin('ccntrAA_coef',ccntrAA_coef)
    124125  call getin('ccntrENV_coef',ccntrENV_coef)
    125126  call getin('coefcoli',coefcoli)
     127!$OMP END MASTER
     128!$OMP BARRIER
    126129  print*,'cvltr coef lessivage convectif', ccntrAA_coef,ccntrENV_coef,coefcoli
    127130

  • LMDZ5/branches/testing/libf/phylmd/etat0_netcdf.F90

    r1750 r1795  
    2424  USE conf_phys_m,            ONLY: conf_phys
    2525! For parameterization of ozone chemistry:
    26   use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
    27   use press_coefoz_m, only: press_coefoz
    28   use regr_pr_o3_m, only: regr_pr_o3
     26  USE regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
     27  USE press_coefoz_m, only: press_coefoz
     28  USE regr_pr_o3_m, only: regr_pr_o3
    2929  USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
     30  USE indice_sol_mod
    3031#endif
    3132  IMPLICIT NONE
    … …  
    4748#include "comvert.h"
    4849#include "comconst.h"
    49 #include "indicesol.h"
    5050#include "dimsoil.h"
    5151#include "temps.h"
    … …  
    101101  LOGICAL :: ok_LES, ok_ade, ok_aie, ok_cdnc, aerosol_couple, new_aod, callstats
    102102  INTEGER :: iflag_radia, flag_aerosol
     103  LOGICAL :: flag_aerosol_strat
    103104  REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
    104105  REAL    :: tau_ratqs
    … …  
    137138                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
    138139                   ok_ade, ok_aie, ok_cdnc, aerosol_couple,             &
    139                    flag_aerosol, new_aod,                               &
     140                   flag_aerosol, flag_aerosol_strat, new_aod,           &
    140141                   bl95_b0, bl95_b1,                                    &
    141142                   read_climoz,                                         &

  • LMDZ5/branches/testing/libf/phylmd/fonte_neige_mod.F90

    r1504 r1795  
    99!****************************************************************************************
    1010  USE dimphy, ONLY : klon
     11  USE indice_sol_mod
    1112
    1213  IMPLICIT NONE
    … …  
    4445! restart file. The other variables are initialized to zero.
    4546!
    46     INCLUDE "indicesol.h"
    4747!****************************************************************************************
    4848! Input argument
    … …  
    120120       tsurf, precip_rain, precip_snow, &
    121121       snow, qsol, tsurf_new, evap)
     122
     123  USE indice_sol_mod
    122124       
    123125! Routine de traitement de la fonte de la neige dans le cas du traitement
    … …  
    139141!   evap
    140142!
    141   INCLUDE "indicesol.h"
    142143  INCLUDE "dimensions.h"
    143144  INCLUDE "YOETHF.h"
    … …  
    315316       fqfonte_out, ffonte_out)
    316317
     318
     319
    317320! Cumulate ffonte, fqfonte and fqcalving respectively for
    318321! all type of surfaces according to their fraction.
    319322!
    320323! This routine is called from physiq.F before histwrite.
    321 
    322     INCLUDE "indicesol.h"
    323 !****************************************************************************************
     324!****************************************************************************************
     325
     326  USE indice_sol_mod
     327
    324328    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
    325329

  • LMDZ5/branches/testing/libf/phylmd/hgardfou.F

    r1664 r1795  
    22! $Id$
    33      SUBROUTINE hgardfou (t,tsol,text)
    4       use dimphy
    5       use phys_state_var_mod
     4      USE dimphy
     5      USE phys_state_var_mod
     6      USE indice_sol_mod
    67      IMPLICIT none
    78c======================================================================
    … …  
    1011#include "dimensions.h"
    1112#include "YOMCST.h"
    12 #include "indicesol.h"
    1313#include "iniprint.h"
    1414      REAL t(klon,klev), tsol(klon,nbsrf)
    … …  
    5757           DO i = 1, jbad
    5858             WRITE(lunout,*)
    59      $       'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
     59     $       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',
    6060     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
    6161     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
    … …  
    7878           DO i = 1, jbad
    7979             WRITE(lunout,*)
    80      $       'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
     80     $       'i,k,temperature,lon,lat,pourc ter,lic,oce,sic =',
    8181     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
    8282     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
    … …  
    104104           DO i = 1, jbad
    105105            WRITE(lunout,*)
    106      $      'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
     106     $      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='
    107107     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
    108108     $      ,pctsrf(jadrs(i),nsrf)
    … …  
    125125           DO i = 1, jbad
    126126            WRITE(lunout,*)
    127      $      'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
     127     $      'i,nsrf,temperature,lon,lat,pourc ter,lic,oce,sic ='
    128128     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
    129129     $      ,pctsrf(jadrs(i),nsrf)

  • LMDZ5/branches/testing/libf/phylmd/hydrol.F

    r766 r1795  
    77     .                  agesno, tsol,qsol,snow,runoff)
    88      USE dimphy
     9      USE indice_sol_mod
     10
    911      IMPLICIT none
    1012c======================================================================
    … …  
    2628cym#include "dimphy.h"
    2729#include "YOMCST.h"
    28 #include "indicesol.h"
    2930c
    3031      REAL chasno ! epaisseur du sol: 0.15 m

  • LMDZ5/branches/testing/libf/phylmd/init_be.F90

    r1750 r1795  
    77  USE comgeomphy
    88  USE infotrac, ONLY : nbtr
     9  USE indice_sol_mod
    910   
    1011  IMPLICIT NONE
    … …  
    2122  INCLUDE "YOMCST.h"
    2223  INCLUDE "YOECUMF.h"
    23   INCLUDE "indicesol.h"
    2424
    2525!
    … …  
    4747  INTEGER              :: nref
    4848  PARAMETER (nref=39)
    49   REAL,DIMENSION(nref) :: pref      ! grille de pression de reference (bas des couches)
     49  REAL,DIMENSION(nref), SAVE :: pref      ! grille de pression de reference (bas des couches)
    5050  DATA pref  /   &
    5151      101249.99999999994, 100387.17261011522, 99447.35334189111,  98357.43412194174,   &

  • LMDZ5/branches/testing/libf/phylmd/initphysto.F90

    r1454 r1795  
    99  USE iophy
    1010  USE control_mod
     11  USE indice_sol_mod
    1112 
    1213  IMPLICIT NONE
    … …  
    4647  INCLUDE "description.h"
    4748  INCLUDE "serre.h"
    48   INCLUDE "indicesol.h"
    4949
    5050!   Arguments

  • LMDZ5/branches/testing/libf/phylmd/initrrnpb.F90

    r1409 r1795  
    66  USE infotrac, ONLY : nbtr
    77  USE traclmdz_mod, ONLY : id_rn, id_pb
     8  USE indice_sol_mod
    89  IMPLICIT NONE
    910!======================================================================
    … …  
    2425! scavtr...output-R- Coefficient de lessivage
    2526!======================================================================
    26   INCLUDE "indicesol.h"
    27 !======================================================================
    28 
     27 
    2928  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf
    3029  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol

  • LMDZ5/branches/testing/libf/phylmd/interfoce_lim.F90

    r793 r1795  
    99  USE mod_grid_phy_lmdz
    1010  USE mod_phys_lmdz_para
     11  USE indice_sol_mod
    1112 
    1213  IMPLICIT NONE
    1314 
    14   INCLUDE "indicesol.h"
    1515  INCLUDE "netcdf.inc"
    1616

  • LMDZ5/branches/testing/libf/phylmd/iophy.F90

    r1707 r1795  
    66! abd  REAL,private,allocatable,dimension(:),save :: io_lat
    77! abd  REAL,private,allocatable,dimension(:),save :: io_lon
    8   REAL,allocatable,dimension(:),save :: io_lat
    9   REAL,allocatable,dimension(:),save :: io_lon
    10   INTEGER, save :: phys_domain_id
    11   INTEGER, save :: npstn
    12   INTEGER, allocatable, dimension(:), save :: nptabij
     8  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
     9  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
     10  INTEGER, SAVE :: phys_domain_id
     11  INTEGER, SAVE :: npstn
     12  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
     13  INTEGER, SAVE :: itau_iophy
     14
     15!$OMP THREADPRIVATE(itau_iophy)
    1316 
    1417  INTERFACE histwrite_phy
    15     MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
     18    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
    1619  END INTERFACE
    1720
    … …  
    322325  end subroutine histbeg_phy_points
    323326 
    324   subroutine histwrite2d_phy(nid,lpoint,name,itau,field)
    325   USE dimphy
    326   USE mod_phys_lmdz_para
     327  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
     328  USE dimphy
     329  USE mod_phys_lmdz_para
     330  USE phys_output_var_mod
    327331  USE ioipsl
    328   implicit none
     332  IMPLICIT NONE
    329333  include 'dimensions.h'
     334  include 'iniprint.h'
    330335   
    331336    integer,intent(in) :: nid
    … …  
    341346    real,allocatable,dimension(:) :: fieldok
    342347
     348
    343349    IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
    344350   
    … …  
    349355     ALLOCATE(index2d(iim*jj_nb))
    350356     ALLOCATE(fieldok(iim*jj_nb))
     357     IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
    351358     CALL histwrite(nid,name,itau,Field2d,iim*jj_nb,index2d)
     359     IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    352360    else
    353361     ALLOCATE(fieldok(npstn))
    … …  
    369377      ENDDO
    370378     endif
     379     IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
    371380     CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
     381     IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    372382!
    373383    endif
    374384    deallocate(index2d)
    375385    deallocate(fieldok)
    376 !$OMP END MASTER   
    377   end subroutine histwrite2d_phy
    378 
    379   subroutine histwrite3d_phy(nid,lpoint,name,itau,field)
    380   USE dimphy
    381   USE mod_phys_lmdz_para
     386!$OMP END MASTER   
     387
     388 
     389  end subroutine histwrite2d_phy_old
     390
     391  subroutine histwrite3d_phy_old(nid,lpoint,name,itau,field)
     392  USE dimphy
     393  USE mod_phys_lmdz_para
     394  USE phys_output_var_mod
    382395
    383396  use ioipsl
    384397  implicit none
    385398  include 'dimensions.h'
     399  include 'iniprint.h'
    386400   
    387401    integer,intent(in) :: nid
    … …  
    396410    real,allocatable, dimension(:,:) :: fieldok
    397411
     412
    398413    IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
    399414    nlev=size(field,2)
    … …  
    411426     ALLOCATE(index3d(iim*jj_nb*nlev))
    412427     ALLOCATE(fieldok(iim*jj_nb,nlev))
     428     IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
    413429     CALL histwrite(nid,name,itau,Field3d,iim*jj_nb*nlev,index3d)
    414     else
     430     IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     431   else
    415432      nlev=size(field,2)
    416433      ALLOCATE(index3d(npstn*nlev))
    … …  
    435452       ENDDO
    436453      endif
     454      IF (prt_level >= 9) write(lunout,*)'Sending ',name,' to IOIPSL'
    437455      CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
     456      IF (prt_level >= 9) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    438457    endif
    439458  deallocate(index3d)
    440459  deallocate(fieldok)
    441460!$OMP END MASTER   
    442   end subroutine histwrite3d_phy
     461
     462  end subroutine histwrite3d_phy_old
     463
     464
     465! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
     466  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
     467  USE dimphy
     468  USE mod_phys_lmdz_para
     469  USE ioipsl
     470!Pour avoir nfiles, nidfiles tout ça tout ça...
     471  USE phys_output_var_mod
     472 
     473 
     474
     475#ifdef CPP_XIOS
     476!  USE WXIOS
     477#endif
     478
     479  IMPLICIT NONE
     480  include 'dimensions.h'
     481   
     482!    integer,intent(in) :: nid
     483!    logical,intent(in) :: lpoint
     484!    character*(*), intent(IN) :: name
     485!    integer, intent(in) :: itau
     486!    real,dimension(:),intent(in) :: field
     487
     488      TYPE(ctrl_out), INTENT(IN) :: var
     489      REAL, DIMENSION(:), INTENT(IN) :: field
     490      INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
     491     
     492      INTEGER :: iff, iff_beg, iff_end
     493     
     494    REAL,dimension(klon_mpi) :: buffer_omp
     495    INTEGER, allocatable, dimension(:) :: index2d
     496    REAL :: Field2d(iim,jj_nb)
     497
     498    INTEGER :: ip
     499    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
     500
     501! ug RUSTINE POUR LES STD LEVS.....
     502      IF (PRESENT(STD_iff)) THEN
     503            iff_beg = STD_iff
     504            iff_end = STD_iff
     505      ELSE
     506            iff_beg = 1
     507            iff_end = nfiles
     508      END IF
     509
     510    IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
     511   
     512    CALL Gather_omp(field,buffer_omp)   
     513!$OMP MASTER
     514    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
     515   
     516! La boucle sur les fichiers:
     517      DO iff=iff_beg, iff_end
     518            IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
     519   
     520                  IF(.NOT.clef_stations(iff)) THEN
     521                        ALLOCATE(index2d(iim*jj_nb))
     522                        ALLOCATE(fieldok(iim*jj_nb))
     523     
     524                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,iim*jj_nb,index2d)
     525#ifdef CPP_XIOS
     526!                        IF (iff .EQ. 1) THEN
     527!                              CALL wxios_write_2D(var%name, Field2d)
     528!                        ENDIF
     529#endif
     530                  ELSE
     531                        ALLOCATE(fieldok(npstn))
     532                        ALLOCATE(index2d(npstn))
     533
     534                        IF (is_sequential) THEN
     535!                            klon_mpi_begin=1
     536!                             klon_mpi_end=klon
     537                              DO ip=1, npstn
     538                                    fieldok(ip)=buffer_omp(nptabij(ip))
     539                              ENDDO
     540                             ELSE
     541                              DO ip=1, npstn
     542!                                   print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
     543                                     IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     544                                        nptabij(ip).LE.klon_mpi_end) THEN
     545                                       fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
     546                                     ENDIF
     547                              ENDDO
     548                       ENDIF
     549     
     550                       CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
     551                  ENDIF
     552                 
     553                deallocate(index2d)
     554                deallocate(fieldok)
     555            ENDIF !levfiles
     556      ENDDO
     557!$OMP END MASTER   
     558
     559  END SUBROUTINE histwrite2d_phy
     560
     561
     562! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
     563  SUBROUTINE histwrite3d_phy(var, field)
     564  USE dimphy
     565  USE mod_phys_lmdz_para
     566
     567  use ioipsl
     568!Pour avoir nfiles, nidfiles tout ça tout ça...
     569  USE phys_output_var_mod 
     570 
     571
     572#ifdef CPP_XIOS
     573! USE WXIOS
     574#endif
     575
     576
     577  IMPLICIT NONE
     578  include 'dimensions.h'
     579   
     580!    integer,intent(in) :: nid
     581!    logical,intent(in) :: lpoint
     582!    character*(*), intent(IN) :: name
     583!    integer, intent(in) :: itau
     584!    real,dimension(:,:),intent(in) :: field  ! --> field(klon,:)
     585
     586      TYPE(ctrl_out), INTENT(IN) :: var
     587      REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
     588
     589
     590    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     591    REAL :: Field3d(iim,jj_nb,SIZE(field,2))
     592    INTEGER :: ip, n, nlev, iff
     593    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     594    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
     595
     596    IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
     597    nlev=size(field,2)
     598
     599!   print*,'hist3d_phy mpi_rank npstn=',mpi_rank,npstn
     600
     601!   DO ip=1, npstn
     602!    print*,'hist3d_phy mpi_rank nptabij',mpi_rank,nptabij(ip)
     603!   ENDDO
     604
     605    CALL Gather_omp(field,buffer_omp)
     606!$OMP MASTER
     607    CALL grid1Dto2D_mpi(buffer_omp,field3d)
     608
     609
     610! BOUCLE SUR LES FICHIERS
     611      DO iff=1, nfiles
     612            IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
     613                IF (.NOT.clef_stations(iff)) THEN
     614                        ALLOCATE(index3d(iim*jj_nb*nlev))
     615                        ALLOCATE(fieldok(iim*jj_nb,nlev))
     616                        CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,iim*jj_nb*nlev,index3d)
     617#ifdef CPP_XIOS
     618!                        IF (iff .EQ. 1) THEN
     619!                              CALL wxios_write_3D(var%name, Field3d(:,:,1:klev))
     620!                        ENDIF
     621#endif
     622                       
     623                ELSE
     624                        nlev=size(field,2)
     625                        ALLOCATE(index3d(npstn*nlev))
     626                        ALLOCATE(fieldok(npstn,nlev))
     627
     628                        IF (is_sequential) THEN
     629            !                  klon_mpi_begin=1
     630            !                  klon_mpi_end=klon
     631                              DO n=1, nlev
     632                                    DO ip=1, npstn
     633                                          fieldok(ip,n)=buffer_omp(nptabij(ip),n)
     634                                    ENDDO
     635                              ENDDO
     636                        ELSE
     637                              DO n=1, nlev
     638                                    DO ip=1, npstn
     639                                                IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     640                                                      nptabij(ip).LE.klon_mpi_end) THEN
     641                                                fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
     642                                          ENDIF
     643                                    ENDDO
     644                              ENDDO
     645                        ENDIF
     646                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
     647                  ENDIF
     648                  deallocate(index3d)
     649                  deallocate(fieldok)
     650            ENDIF
     651      ENDDO
     652!$OMP END MASTER   
     653  END SUBROUTINE histwrite3d_phy
    443654 
    444655end module iophy

  • LMDZ5/branches/testing/libf/phylmd/limit_netcdf.F90

    r1707 r1795  
    2121!-------------------------------------------------------------------------------
    2222  USE control_mod
     23  USE indice_sol_mod
    2324#ifdef CPP_EARTH
    2425  USE dimphy
    … …  
    5051#include "comgeom2.h"
    5152#include "comconst.h"
    52 #include "indicesol.h"
    5353
    5454!--- INPUT NETCDF FILES NAMES --------------------------------------------------
    … …  
    276276  USE phys_state_var_mod, ONLY : pctsrf
    277277  USE control_mod
    278   use pchsp_95_m, only: pchsp_95
    279   use pchfe_95_m, only: pchfe_95
    280   use arth_m, only: arth
     278  USE pchsp_95_m, only: pchsp_95
     279  USE pchfe_95_m, only: pchfe_95
     280  USE arth_m, only: arth
     281  USE indice_sol_mod
    281282
    282283  IMPLICIT NONE
    … …  
    284285#include "paramet.h"
    285286#include "comgeom2.h"
    286 #include "indicesol.h"
    287287#include "iniprint.h"
    288288!-----------------------------------------------------------------------------

  • LMDZ5/branches/testing/libf/phylmd/limit_read_mod.F90

    r1665 r1795  
    3838
    3939    USE dimphy
    40     INCLUDE "indicesol.h"
     40    USE indice_sol_mod
    4141
    4242! Input arguments
    … …  
    146146    USE surface_data, ONLY : type_ocean, ok_veget
    147147    USE netcdf
     148    USE indice_sol_mod
    148149
    149150    IMPLICIT NONE
    150151   
    151     INCLUDE "indicesol.h"
    152152    INCLUDE "iniprint.h"
    153153

  • LMDZ5/branches/testing/libf/phylmd/limit_slab.F90

    r1001 r1795  
    77  USE mod_phys_lmdz_para
    88  USE netcdf
     9  USE indice_sol_mod
    910
    1011  IMPLICIT NONE
    1112
    12   INCLUDE "indicesol.h"
    1313  INCLUDE "temps.h"
    1414  INCLUDE "clesphys.h"

  • LMDZ5/branches/testing/libf/phylmd/ocean_cpl_mod.F90

    r1146 r1795  
    6262    USE cpl_mod
    6363    USE calcul_fluxs_mod
    64 
    65     INCLUDE "indicesol.h"
     64    USE indice_sol_mod
     65
    6666    INCLUDE "YOMCST.h"
    6767!   
    … …  
    197197    USE cpl_mod
    198198    USE calcul_fluxs_mod
    199 
    200     INCLUDE "indicesol.h"
     199    USE indice_sol_mod
     200
    201201    INCLUDE "YOMCST.h"
    202202

  • LMDZ5/branches/testing/libf/phylmd/ocean_forced_mod.F90

    r1067 r1795  
    3030    USE calcul_fluxs_mod
    3131    USE limit_read_mod
    32     INCLUDE "indicesol.h"
     32    USE indice_sol_mod
     33
    3334    INCLUDE "YOMCST.h"
    3435
    … …  
    137138    USE limit_read_mod
    138139    USE fonte_neige_mod,  ONLY : fonte_neige
    139 
    140     INCLUDE "indicesol.h"
     140    USE indice_sol_mod
     141
    141142    INCLUDE "dimsoil.h"
    142143    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phylmd/ocean_slab_mod.F90

    r1067 r1795  
    1818    USE limit_read_mod
    1919    USE surface_data
    20     INCLUDE "indicesol.h"
     20    USE indice_sol_mod
     21
    2122!    INCLUDE "clesphys.h"
    2223
    … …  
    6061    USE dimphy
    6162    USE calcul_fluxs_mod
    62  
    63     INCLUDE "indicesol.h"
     63    USE indice_sol_mod
     64
    6465    INCLUDE "iniprint.h"
    6566

  • LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90

    r1707 r1795  
    4242  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: agesno ! age of snow at surface
    4343  !$OMP THREADPRIVATE(agesno)
    44   REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: ftsoil ! soil temperature
     44! Correction pour le cas AMMA (PRIVATE)
     45  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ftsoil ! soil temperature
    4546  !$OMP THREADPRIVATE(ftsoil)
    4647
    … …  
    5657! for the index of the different surfaces and tests the choice of type of ocean.
    5758
    58     INCLUDE "indicesol.h"
     59    USE indice_sol_mod
     60
    5961    INCLUDE "dimsoil.h"
    6062    INCLUDE "iniprint.h"
    … …  
    176178       alb1_m,    alb2_m,    zxsens,   zxevap,        &
    177179       zxtsol,    zxfluxlat, zt2m,     qsat2m,        &
    178        d_t,       d_q,       d_u,      d_v,           &
     180       d_t,       d_q,       d_u,      d_v, d_t_diss, &
    179181       zcoefh,    zcoefm,    slab_wfbils,             &
    180182       qsol_d,    zq2m,      s_pblh,   s_plcl,        &
    … …  
    247249!
    248250    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
     251    USE indice_sol_mod
     252
    249253    IMPLICIT NONE
    250254
    251     INCLUDE "indicesol.h"
    252255    INCLUDE "dimsoil.h"
    253256    INCLUDE "YOMCST.h"
    … …  
    259262    INCLUDE "YOETHF.h"
    260263    INCLUDE "temps.h"
     264!****************************************************************************************
     265! Declarations specifiques pour le 1D. A reprendre
    261266! Input variables
    262267!****************************************************************************************
    … …  
    291296    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: u10m    ! u speed at 10m
    292297    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: v10m    ! v speed at 10m
    293     REAL, DIMENSION(klon, klev+1, nbsrf), INTENT(INOUT) :: tke
     298    REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke
    294299
    295300! Output variables
    … …  
    310315    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
    311316    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature
     317    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t_diss       ! change in temperature
    312318    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_q        ! change in water vapour
    313319    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_u        ! change in u speed
    314320    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_v        ! change in v speed
    315     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zcoefh     ! coef for turbulent diffusion of T and Q, mean for each grid point
    316     REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zcoefm     ! coef for turbulent diffusion of U and V (?), mean for each grid point
     321    REAL, DIMENSION(klon, klev,nbsrf+1),  INTENT(OUT)       :: zcoefh     ! coef for turbulent diffusion of T and Q, mean for each grid point
     322    REAL, DIMENSION(klon, klev,nbsrf+1),  INTENT(OUT)       :: zcoefm     ! coef for turbulent diffusion of U and V (?), mean for each grid point
    317323
    318324! Output only for diagnostics
    … …  
    424430    REAL, DIMENSION(klon)              :: ztsol
    425431    REAL, DIMENSION(klon)              :: alb_m  ! mean albedo for whole SW interval
    426     REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q
     432    REAL, DIMENSION(klon,klev)         :: y_d_t, y_d_q, y_d_t_diss
    427433    REAL, DIMENSION(klon,klev)         :: y_d_u, y_d_v
    428434    REAL, DIMENSION(klon,klev)         :: y_flux_t, y_flux_q
    429435    REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
    430     REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm
     436    REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm,ycoefq
    431437    REAL, DIMENSION(klon)              :: ycdragh, ycdragm
    432438    REAL, DIMENSION(klon,klev)         :: yu, yv
    … …  
    470476!****************************************************************************************
    471477! Declarations specifiques pour le 1D. A reprendre
     478!****************************************************************************************
    472479  REAL  :: fsens,flat
    473480  LOGICAL :: ok_flux_surf ! initialized during first_call below
    474481  COMMON /flux_arp/fsens,flat,ok_flux_surf
    475 !****************************************************************************************
    476482! End of declarations
    477483!****************************************************************************************
    … …  
    546552    d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
    547553    flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0     
    548     d_u = 0.0     ; d_v = 0.0        ; yqsol = 0.0   
     554    d_t_diss= 0.0 ;d_u = 0.0     ; d_v = 0.0        ; yqsol = 0.0   
    549555    ytherm = 0.0  ; ytke=0.
    550556   
    551     zcoefh(:,:) = 0.0
    552     zcoefh(:,1) = 999999. ! zcoefh(:,k=1) should never be used
    553     zcoefm(:,:) = 0.0
    554     zcoefm(:,1) = 999999. !
     557    tke(:,:,is_ave)=0.
     558    IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
     559       zcoefh(:,:,:) = 0.0
     560       zcoefh(:,1,:) = 999999. ! zcoefh(:,k=1) should never be used
     561       zcoefm(:,:,:) = 0.0
     562       zcoefm(:,1,:) = 999999. !
     563    ELSE
     564      zcoefm(:,:,is_ave)=0.
     565      zcoefh(:,:,is_ave)=0.
     566    ENDIF
    555567    ytsoil = 999999.
    556568
    … …  
    713725          ENDDO
    714726       ENDDO
    715        
     727
    716728       DO k = 1, nsoilmx
    717729          DO j = 1, knon
    … …  
    747759            ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
    748760            ycoefm, ycoefh, ytke)
     761
     762       IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN
     763! In this case, coef_diff_turb is called for the Cd only
     764       DO k = 2, klev
     765          DO j = 1, knon
     766             i = ni(j)
     767             ycoefh(j,k)   = zcoefh(i,k,nsrf)
     768             ycoefm(j,k)   = zcoefm(i,k,nsrf)
     769          ENDDO
     770       ENDDO
     771       ENDIF
    749772       
    750773!****************************************************************************************
    … …  
    924947
    925948
     949     y_d_t_diss(:,:)=0.
     950     IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN
     951        CALL yamada_c(knon,dtime,ypaprs,ypplay &
     952    &   ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
     953    &   ,iflag_pbl,nsrf)
     954     ENDIF
     955!     print*,'yamada_c OK'
     956
    926957       DO j = 1, knon
    927958          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
    … …  
    937968!****************************************************************************************
    938969
    939        tke(:,:,nsrf) = 0.
    940970       DO k = 1, klev
    941971          DO j = 1, knon
    942972             i = ni(j)
     973             y_d_t_diss(j,k)  = y_d_t_diss(j,k) * ypct(j)
    943974             y_d_t(j,k)  = y_d_t(j,k) * ypct(j)
    944975             y_d_q(j,k)  = y_d_q(j,k) * ypct(j)
    … …  
    951982             flux_v(i,k,nsrf) = y_flux_v(j,k)
    952983
    953              tke(i,k,nsrf)    = ytke(j,k)
    954984
    955985          ENDDO
    956986       ENDDO
     987
     988!      print*,'Dans pbl OK1'
    957989
    958990       evap(:,nsrf) = - flux_q(:,1,nsrf)
    … …  
    9801012       END DO
    9811013
     1014!      print*,'Dans pbl OK2'
     1015
    9821016       DO k = 2, klev
    9831017          DO j = 1, knon
    9841018             i = ni(j)
    985              zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)*ypct(j)
    986              zcoefm(i,k) = zcoefm(i,k) + ycoefm(j,k)*ypct(j)
     1019             tke(i,k,nsrf)    = ytke(j,k)
     1020             zcoefh(i,k,nsrf) = ycoefh(j,k)
     1021             zcoefm(i,k,nsrf) = ycoefm(j,k)
     1022             tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)
     1023             zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
     1024             zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
    9871025          END DO
    9881026       END DO
     1027
     1028!      print*,'Dans pbl OK3'
    9891029
    9901030       IF ( nsrf .EQ. is_ter ) THEN
    … …  
    10071047          DO j = 1, knon
    10081048             i = ni(j)
     1049             d_t_diss(i,k) = d_t_diss(i,k) + y_d_t_diss(j,k)
    10091050             d_t(i,k) = d_t(i,k) + y_d_t(j,k)
    10101051             d_q(i,k) = d_q(i,k) + y_d_q(j,k)
    … …  
    10131054          END DO
    10141055       END DO
     1056
     1057!      print*,'Dans pbl OK4'
    10151058
    10161059!****************************************************************************************
    … …  
    10401083! Calculations of diagnostic t,q at 2m and u, v at 10m
    10411084
     1085!      print*,'Dans pbl OK41'
     1086!      print*,'tair1,yt(:,1),y_d_t(:,1)'
     1087!      print*, tair1,yt(:,1),y_d_t(:,1)
    10421088       DO j=1, knon
    10431089          i = ni(j)
    10441090          uzon(j) = yu(j,1) + y_d_u(j,1)
    10451091          vmer(j) = yv(j,1) + y_d_v(j,1)
    1046           tair1(j) = yt(j,1) + y_d_t(j,1)
     1092          tair1(j) = yt(j,1) + y_d_t(j,1) + y_d_t_diss(j,1)
    10471093          qair1(j) = yq(j,1) + y_d_q(j,1)
    10481094          zgeo1(j) = RD * tair1(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) &
    … …  
    10581104       END DO
    10591105       
     1106!      print*,'Dans pbl OK42A'
     1107!      print*,'tair1,yt(:,1),y_d_t(:,1)'
     1108!      print*, tair1,yt(:,1),y_d_t(:,1)
    10601109
    10611110! Calculate the temperature et relative humidity at 2m and the wind at 10m
    … …  
    10641113            tairsol, qairsol, rugo1, psfce, patm, &
    10651114            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     1115!      print*,'Dans pbl OK42B'
    10661116
    10671117       DO j=1, knon
    … …  
    10771127       END DO
    10781128
     1129!      print*,'Dans pbl OK43'
    10791130!IM Calcule de l'humidite relative a 2m (rh2m) pour diagnostique
    10801131!IM Ajoute dependance type surface
    … …  
    10931144       END IF
    10941145
     1146!   print*,'OK pbl 5'
    10951147       CALL HBTM(knon, ypaprs, ypplay, &
    10961148            yt2m,yt10m,yq2m,yq10m,yustar, &
    … …  
    11131165       END DO
    11141166       
     1167!   print*,'OK pbl 6'
    11151168#else
    11161169! T2m not defined
    … …  
    11301183!****************************************************************************************
    11311184   
     1185!   print*,'OK pbl 7'
    11321186    zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0
    11331187    zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0
    … …  
    11431197    END DO
    11441198
     1199!   print*,'OK pbl 8'
    11451200    DO i = 1, klon
    11461201       zxsens(i)     = - zxfluxt(i,1) ! flux de chaleur sensible au sol
    … …  
    11611216    s_trmb2(:) = 0.0 ; s_trmb3(:) = 0.0
    11621217   
     1218!   print*,'OK pbl 9'
    11631219   
    11641220    DO nsrf = 1, nbsrf
    … …  
    11921248       END DO
    11931249    END DO
     1250!   print*,'OK pbl 10'
    11941251
    11951252    IF (check) THEN
    … …  
    12641321       evap_rst, rugos_rst, agesno_rst, ftsoil_rst)
    12651322
    1266     INCLUDE "indicesol.h"
     1323    USE indice_sol_mod
     1324
    12671325    INCLUDE "dimsoil.h"
    12681326
    … …  
    13141372    ! Give default values where new fraction has appread
    13151373
    1316     INCLUDE "indicesol.h"
     1374    USE indice_sol_mod
     1375
    13171376    INCLUDE "dimsoil.h"
    13181377    INCLUDE "clesphys.h"

  • LMDZ5/branches/testing/libf/phylmd/phyaqua.F

    r1707 r1795  
    1616!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1717
    18       use comgeomphy, only : rlatd,rlond
    19       use dimphy, only : klon
    20       use surface_data, only : type_ocean,ok_veget
    21       use pbl_surface_mod, only : pbl_surface_init
     18      USE comgeomphy, only : rlatd,rlond
     19      USE dimphy, only : klon
     20      USE surface_data, only : type_ocean,ok_veget
     21      USE pbl_surface_mod, only : pbl_surface_init
    2222      USE fonte_neige_mod, only : fonte_neige_init
    23       use phys_state_var_mod
    24       use control_mod, only : dayref,nday,iphysiq
     23      USE phys_state_var_mod
     24      USE control_mod, only : dayref,nday,iphysiq
     25      USE indice_sol_mod
    2526
    2627      USE IOIPSL
    … …  
    3334#include "clesphys.h"
    3435#include "dimsoil.h"
    35 #include "indicesol.h"
    3636#include "temps.h"
    3737
    … …  
    8989      integer, save::  read_climoz=0 ! read ozone climatology
    9090
    91 
     91! intermediate variables to use getin
     92      integer :: nbapp_rad_omp
     93      real :: co2_ppm_omp,solaire_omp
     94      logical :: alb_ocean_omp
     95      real :: rugos_omp
    9296!-------------------------------------------------------------------------
    9397!  declaration pour l'appel a phyredem
    … …  
    160164         zcufi=1.
    161165         zcvfi=1.
    162       nbapp_rad=24
    163       CALL getin('nbapp_rad',nbapp_rad)
     166!$OMP MASTER
     167      nbapp_rad_omp=24
     168      CALL getin('nbapp_rad',nbapp_rad_omp)
     169!$OMP END MASTER
     170!$OMP BARRIER
     171      nbapp_rad=nbapp_rad_omp
    164172
    165173!---------------------------------------------------------------------
    … …  
    168176! Initialisations des constantes
    169177! Ajouter les manquants dans planete.def... (albedo etc)
    170       co2_ppm=348.
    171       CALL getin('co2_ppm',co2_ppm)
    172       solaire=1365.
    173       CALL getin('solaire',solaire)
     178!$OMP MASTER
     179      co2_ppm_omp=348.
     180      CALL getin('co2_ppm',co2_ppm_omp)
     181      solaire_omp=1365.
     182      CALL getin('solaire',solaire_omp)
     183!      CALL getin('albedo',albedo) ! albedo is set below, depending on type_aqua
     184      alb_ocean_omp=.true.
     185      CALL getin('alb_ocean',alb_ocean_omp)
     186!$OMP END MASTER
     187!$OMP BARRIER
     188      co2_ppm=co2_ppm_omp
     189      solaire=solaire_omp
     190      alb_ocean=alb_ocean_omp
     191
    174192      radsol=0.
    175193      qsol_f=10.
    176 !      CALL getin('albedo',albedo) ! albedo is set below, depending on type_aqua
    177       alb_ocean=.true.
    178       CALL getin('alb_ocean',alb_ocean)
    179194
    180195c  Conditions aux limites:
    … …  
    208223      endif
    209224
    210       CALL getin('rugos',rugos)
     225!$OMP MASTER
     226      rugos_omp=rugos
     227      CALL getin('rugos',rugos_omp)
     228!$OMP END MASTER
     229!$OMP BARRIER
     230      rugos=rugos_omp
    211231      zmasq(:)=pctsrf(:,is_oce)
    212232

  • LMDZ5/branches/testing/libf/phylmd/phyetat0.F

    r1707 r1795  
    2323      USE carbon_cycle_mod,ONLY :
    2424     &     carbon_cycle_tr, carbon_cycle_cpl, co2_send
     25      USE indice_sol_mod
    2526
    2627      IMPLICIT none
    … …  
    3132#include "dimensions.h"
    3233#include "netcdf.inc"
    33 #include "indicesol.h"
    3434#include "dimsoil.h"
    3535#include "clesphys.h"

  • LMDZ5/branches/testing/libf/phylmd/phyredem.F

    r1665 r1795  
    1616      USE control_mod
    1717      USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
     18      USE indice_sol_mod
    1819
    1920      IMPLICIT none
    … …  
    2324c======================================================================
    2425#include "netcdf.inc"
    25 #include "indicesol.h"
    2626#include "dimsoil.h"
    2727#include "clesphys.h"

  • LMDZ5/branches/testing/libf/phylmd/phys_local_var_mod.F90

    r1750 r1795  
    5555      REAL, SAVE, ALLOCATABLE :: d_u_oli(:,:), d_v_oli(:,:)
    5656      !$OMP THREADPRIVATE(d_u_oli, d_v_oli)
    57       REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:)
    58       !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf)
     57      REAL, SAVE, ALLOCATABLE :: d_t_vdf(:,:), d_q_vdf(:,:), d_t_diss(:,:)
     58      !$OMP THREADPRIVATE( d_t_vdf, d_q_vdf,d_t_diss)
    5959      REAL, SAVE, ALLOCATABLE :: d_u_vdf(:,:), d_v_vdf(:,:)
    6060      !$OMP THREADPRIVATE(d_u_vdf, d_v_vdf)
    … …  
    191191!======================================================================
    192192SUBROUTINE phys_local_var_init
    193 use dimphy
    194 use infotrac, ONLY : nbtr
     193USE dimphy
     194USE infotrac, ONLY : nbtr
    195195USE aero_mod
     196USE indice_sol_mod
    196197
    197198IMPLICIT NONE
    198 #include "indicesol.h"
    199199      allocate(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
    200200      allocate(u_seri(klon,klev),v_seri(klon,klev))
    … …  
    216216      allocate(d_t_lscth(klon,klev),d_q_lscth(klon,klev))
    217217      allocate(plul_st(klon),plul_th(klon))
    218       allocate(d_t_vdf(klon,klev),d_q_vdf(klon,klev))
     218      allocate(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
    219219      allocate(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
    220220      allocate(d_t_oli(klon,klev),d_t_oro(klon,klev))
    … …  
    283283!======================================================================
    284284SUBROUTINE phys_local_var_end
    285 use dimphy
     285USE dimphy
     286USE indice_sol_mod
    286287IMPLICIT NONE
    287 #include "indicesol.h"
    288288      deallocate(t_seri,q_seri,ql_seri,qs_seri)
    289289      deallocate(u_seri,v_seri)
    … …  
    305305      deallocate(d_t_lscth,d_q_lscth)
    306306      deallocate(plul_st,plul_th)
    307       deallocate(d_t_vdf,d_q_vdf)
     307      deallocate(d_t_vdf,d_q_vdf,d_t_diss)
    308308      deallocate(d_u_vdf,d_v_vdf)
    309309      deallocate(d_t_oli,d_t_oro)

  • LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90

    r1750 r1795  
    1111
    1212MODULE phys_output_mod
     13  USE indice_sol_mod
     14  USE phys_output_var_mod
     15  USE phys_output_ctrlout_mod
     16  USE aero_mod, only : naero_spc,name_aero
    1317
    1418  IMPLICIT NONE
    1519
    16   private histdef2d, histdef3d, conf_physoutputs
    17 
    18 
    19   integer, parameter                           :: nfiles = 6
    20   logical, dimension(nfiles), save             :: clef_files
    21   logical, dimension(nfiles), save             :: clef_stations
    22   integer, dimension(nfiles), save             :: lev_files
    23   integer, dimension(nfiles), save             :: nid_files
    24   integer, dimension(nfiles), save  :: nnid_files
    25 !!$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files)
    26   integer, dimension(nfiles), private, save :: nnhorim
    27 
    28   integer, dimension(nfiles), private, save :: nhorim, nvertm
    29   integer, dimension(nfiles), private, save :: nvertap, nvertbp, nvertAlt
    30   !   integer, dimension(nfiles), private, save :: nvertp0
    31   real, dimension(nfiles), private, save                :: zoutm
    32   real,                    private, save                :: zdtime
    33   CHARACTER(len=20), dimension(nfiles), private, save   :: type_ecri
    34   !$OMP THREADPRIVATE(nhorim, nvertm, zoutm,zdtime,type_ecri)
    35  ! swaero_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
    36   logical, save                                :: swaero_diag=.FALSE.
    37 
    38 
    39   !   integer, save                     :: nid_hf3d
    40 
    41 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    42   !! Definition pour chaque variable du niveau d ecriture dans chaque fichier
    43 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/ histmth, histday, histhf, histins /),'!!!!!!!!!!!!
    44 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    45 
    46   integer, private:: levmin(nfiles) = 1
    47   integer, private:: levmax(nfiles)
    48 
    49   TYPE ctrl_out
    50      integer,dimension(6) :: flag
    51      character(len=20)     :: name
    52   END TYPE ctrl_out
    53 
    54 !!! Comosentes de la coordonnee sigma-hybride
    55 !!! Ap et Bp
    56   type(ctrl_out),save :: o_Ahyb         = ctrl_out((/ 1, 1, 1, 1, 1, 1 /), 'Ap')
    57   type(ctrl_out),save :: o_Bhyb         = ctrl_out((/ 1, 1, 1, 1, 1, 1 /), 'Bp')
    58   type(ctrl_out),save :: o_Alt          = ctrl_out((/ 1, 1, 1, 1, 1, 1 /), 'Alt')
    59 
    60 !!! 1D
    61   type(ctrl_out),save :: o_phis         = ctrl_out((/ 1, 1, 10, 5, 1, 1 /), 'phis')
    62   type(ctrl_out),save :: o_aire         = ctrl_out((/ 1, 1, 10,  10, 1, 1 /),'aire')
    63   type(ctrl_out),save :: o_contfracATM  = ctrl_out((/ 10, 1,  1, 10, 10, 10 /),'contfracATM')
    64   type(ctrl_out),save :: o_contfracOR   = ctrl_out((/ 10, 1,  1, 10, 10, 10 /),'contfracOR')
    65   type(ctrl_out),save :: o_aireTER      = ctrl_out((/ 10, 10, 1, 10, 10, 10 /),'aireTER')
    66 
    67 !!! 2D
    68   type(ctrl_out),save :: o_flat         = ctrl_out((/ 5, 1, 10, 10, 5, 10 /),'flat')
    69   type(ctrl_out),save :: o_slp          = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'slp')
    70   type(ctrl_out),save :: o_tsol         = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'tsol')
    71   type(ctrl_out),save :: o_t2m          = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'t2m')
    72   type(ctrl_out),save :: o_t2m_min      = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'t2m_min')
    73   type(ctrl_out),save :: o_t2m_max      = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'t2m_max')
    74   type(ctrl_out),save,dimension(4) :: o_t2m_srf      = (/ ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'t2m_ter'), &
    75        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'t2m_lic'), &
    76        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'t2m_oce'), &
    77        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'t2m_sic') /)
    78 
    79   type(ctrl_out),save :: o_wind10m      = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'wind10m')
    80   type(ctrl_out),save :: o_wind10max    = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'wind10max')
    81   type(ctrl_out),save :: o_sicf         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'sicf')
    82   type(ctrl_out),save :: o_q2m          = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'q2m')
    83   type(ctrl_out),save :: o_ustar        = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'ustar')
    84   type(ctrl_out),save :: o_u10m         = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'u10m')
    85   type(ctrl_out),save :: o_v10m         = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'v10m')
    86   type(ctrl_out),save :: o_psol         = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'psol')
    87   type(ctrl_out),save :: o_qsurf        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'qsurf')
    88 
    89   type(ctrl_out),save,dimension(4) :: o_ustar_srf     = (/ ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_ter'), &
    90        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_lic'), &
    91        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_oce'), &
    92        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_sic') /)
    93   type(ctrl_out),save,dimension(4) :: o_u10m_srf     = (/ ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'u10m_ter'), &
    94        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'u10m_lic'), &
    95        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'u10m_oce'), &
    96        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'u10m_sic') /)
    97 
    98   type(ctrl_out),save,dimension(4) :: o_v10m_srf     = (/ ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'v10m_ter'), &
    99        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'v10m_lic'), &
    100        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'v10m_oce'), &
    101        ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'v10m_sic') /)
    102 
    103   type(ctrl_out),save :: o_qsol         = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'qsol')
    104 
    105   type(ctrl_out),save :: o_ndayrain     = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'ndayrain')
    106   type(ctrl_out),save :: o_precip       = ctrl_out((/ 1, 1, 1, 10, 5, 10 /),'precip')
    107   type(ctrl_out),save :: o_plul         = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'plul')
    108 
    109   type(ctrl_out),save :: o_pluc         = ctrl_out((/ 1, 1, 1, 10, 5, 10 /),'pluc')
    110   type(ctrl_out),save :: o_snow         = ctrl_out((/ 1, 1, 10, 10, 5, 10 /),'snow')
    111   type(ctrl_out),save :: o_evap         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'evap')
    112   type(ctrl_out),save,dimension(4) :: o_evap_srf     = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'evap_ter'), &
    113        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'evap_lic'), &
    114        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'evap_oce'), &
    115        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'evap_sic') /)
    116   type(ctrl_out),save :: o_msnow       = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'msnow')
    117   type(ctrl_out),save :: o_fsnow       = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fsnow')
    118 
    119   type(ctrl_out),save :: o_tops         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'tops')
    120   type(ctrl_out),save :: o_tops0        = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'tops0')
    121   type(ctrl_out),save :: o_topl         = ctrl_out((/ 1, 1, 10, 5, 10, 10 /),'topl')
    122   type(ctrl_out),save :: o_topl0        = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'topl0')
    123   type(ctrl_out),save :: o_SWupTOA      = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'SWupTOA')
    124   type(ctrl_out),save :: o_SWupTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'SWupTOAclr')
    125   type(ctrl_out),save :: o_SWdnTOA      = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'SWdnTOA')
    126   type(ctrl_out),save :: o_SWdnTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'SWdnTOAclr')
    127   type(ctrl_out),save :: o_nettop       = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'nettop')
    128 
    129   type(ctrl_out),save :: o_SWup200      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'SWup200')
    130   type(ctrl_out),save :: o_SWup200clr   = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'SWup200clr')
    131   type(ctrl_out),save :: o_SWdn200      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'SWdn200')
    132   type(ctrl_out),save :: o_SWdn200clr   = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'SWdn200clr')
    133 
    134   ! arajouter
    135   !  type(ctrl_out),save :: o_LWupTOA     = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'LWupTOA')
    136   !  type(ctrl_out),save :: o_LWupTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'LWupTOAclr')
    137   !  type(ctrl_out),save :: o_LWdnTOA     = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'LWdnTOA')
    138   !  type(ctrl_out),save :: o_LWdnTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10, 10 /),'LWdnTOAclr')
    139 
    140   type(ctrl_out),save :: o_LWup200      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'LWup200')
    141   type(ctrl_out),save :: o_LWup200clr   = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'LWup200clr')
    142   type(ctrl_out),save :: o_LWdn200      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'LWdn200')
    143   type(ctrl_out),save :: o_LWdn200clr   = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'LWdn200clr')
    144   type(ctrl_out),save :: o_sols         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'sols')
    145   type(ctrl_out),save :: o_sols0        = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'sols0')
    146   type(ctrl_out),save :: o_soll         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'soll')
    147   type(ctrl_out),save :: o_soll0        = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'soll0')
    148   type(ctrl_out),save :: o_radsol       = ctrl_out((/ 1, 7, 10, 10, 10, 10 /),'radsol')
    149   type(ctrl_out),save :: o_SWupSFC      = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'SWupSFC')
    150   type(ctrl_out),save :: o_SWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'SWupSFCclr')
    151   type(ctrl_out),save :: o_SWdnSFC      = ctrl_out((/ 1, 1, 10, 10, 5, 10 /),'SWdnSFC')
    152   type(ctrl_out),save :: o_SWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'SWdnSFCclr')
    153   type(ctrl_out),save :: o_LWupSFC      = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'LWupSFC')
    154   type(ctrl_out),save :: o_LWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'LWupSFCclr')
    155   type(ctrl_out),save :: o_LWdnSFC      = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'LWdnSFC')
    156   type(ctrl_out),save :: o_LWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5, 10 /),'LWdnSFCclr')
    157   type(ctrl_out),save :: o_bils         = ctrl_out((/ 1, 2, 10, 5, 10, 10 /),'bils')
    158   type(ctrl_out),save :: o_sens         = ctrl_out((/ 1, 1, 10, 10, 5, 10 /),'sens')
    159   type(ctrl_out),save :: o_fder         = ctrl_out((/ 1, 2, 10, 10, 10, 10 /),'fder')
    160   type(ctrl_out),save :: o_ffonte       = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'ffonte')
    161   type(ctrl_out),save :: o_fqcalving    = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fqcalving')
    162   type(ctrl_out),save :: o_fqfonte      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fqfonte')
    163 
    164   type(ctrl_out),save :: o_taux         = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'taux')
    165   type(ctrl_out),save :: o_tauy         = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'tauy')
    166   type(ctrl_out),save,dimension(4) :: o_taux_srf     = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'taux_ter'), &
    167        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'taux_lic'), &
    168        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'taux_oce'), &
    169        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'taux_sic') /)
    170 
    171   type(ctrl_out),save,dimension(4) :: o_tauy_srf     = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tauy_ter'), &
    172        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tauy_lic'), &
    173        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tauy_oce'), &
    174        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tauy_sic') /)
    175 
    176 
    177   type(ctrl_out),save,dimension(4) :: o_pourc_srf    = (/ ctrl_out((/ 1, 7, 10, 10, 10, 10 /),'pourc_ter'), &
    178        ctrl_out((/ 1, 7, 10, 10, 10, 10 /),'pourc_lic'), &
    179        ctrl_out((/ 1, 7, 10, 10, 10, 10 /),'pourc_oce'), &
    180        ctrl_out((/ 1, 7, 10, 10, 10, 10 /),'pourc_sic') /)     
    181 
    182   type(ctrl_out),save,dimension(4) :: o_fract_srf    = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'fract_ter'), &
    183        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'fract_lic'), &
    184        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'fract_oce'), &
    185        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'fract_sic') /)
    186 
    187   type(ctrl_out),save,dimension(4) :: o_tsol_srf     = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tsol_ter'), &
    188        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tsol_lic'), &
    189        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tsol_oce'), &
    190        ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'tsol_sic') /)
    191 
    192   type(ctrl_out),save,dimension(4) :: o_evappot_srf  = (/ ctrl_out((/ 1, 6, 10, 10, 10, 10 /),'evappot_ter'), &
    193        ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'evappot_lic'), &
    194        ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'evappot_oce'), &
    195        ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'evappot_sic') /)
    196 
    197   type(ctrl_out),save,dimension(4) :: o_sens_srf     = (/ ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'sens_ter'), &
    198        ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'sens_lic'), &
    199        ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'sens_oce'), &
    200        ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'sens_sic') /)
    201 
    202   type(ctrl_out),save,dimension(4) :: o_lat_srf      = (/ ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'lat_ter'), &
    203        ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'lat_lic'), &
    204        ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'lat_oce'), &
    205        ctrl_out((/ 1, 6, 10, 7, 10, 10 /),'lat_sic') /)
    206 
    207   type(ctrl_out),save,dimension(4) :: o_flw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'flw_ter'), &
    208        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'flw_lic'), &
    209        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'flw_oce'), &
    210        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'flw_sic') /)
    211 
    212   type(ctrl_out),save,dimension(4) :: o_fsw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fsw_ter'), &
    213        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fsw_lic'), &
    214        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fsw_oce'), &
    215        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fsw_sic') /)
    216 
    217   type(ctrl_out),save,dimension(4) :: o_wbils_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbils_ter'), &
    218        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbils_lic'), &
    219        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbils_oce'), &
    220        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbils_sic') /)
    221 
    222   type(ctrl_out),save,dimension(4) :: o_wbilo_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbilo_ter'), &
    223        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbilo_lic'), &
    224        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbilo_oce'), &
    225        ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbilo_sic') /)
    226 
    227 
    228   type(ctrl_out),save :: o_cdrm         = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'cdrm')
    229   type(ctrl_out),save :: o_cdrh         = ctrl_out((/ 1, 10, 10, 7, 10, 10 /),'cdrh')
    230   type(ctrl_out),save :: o_cldl         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'cldl')
    231   type(ctrl_out),save :: o_cldm         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'cldm')
    232   type(ctrl_out),save :: o_cldh         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'cldh')
    233   type(ctrl_out),save :: o_cldt         = ctrl_out((/ 1, 1, 2, 10, 5, 10 /),'cldt')
    234   type(ctrl_out),save :: o_cldq         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'cldq')
    235   type(ctrl_out),save :: o_lwp          = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'lwp')
    236   type(ctrl_out),save :: o_iwp          = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'iwp')
    237   type(ctrl_out),save :: o_ue           = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'ue')
    238   type(ctrl_out),save :: o_ve           = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'ve')
    239   type(ctrl_out),save :: o_uq           = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'uq')
    240   type(ctrl_out),save :: o_vq           = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'vq')
    241 
    242   type(ctrl_out),save :: o_cape         = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'cape')
    243   type(ctrl_out),save :: o_pbase        = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'pbase')
    244   type(ctrl_out),save :: o_ptop         = ctrl_out((/ 1, 5, 10, 10, 10, 10 /),'ptop')
    245   type(ctrl_out),save :: o_fbase        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'fbase')
    246   type(ctrl_out),save :: o_plcl        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'plcl')
    247   type(ctrl_out),save :: o_plfc        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'plfc')
    248   type(ctrl_out),save :: o_wbeff        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'wbeff')
    249   type(ctrl_out),save :: o_prw          = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'prw')
    250 
    251   type(ctrl_out),save :: o_s_pblh       = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_pblh')
    252   type(ctrl_out),save :: o_s_pblt       = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_pblt')
    253   type(ctrl_out),save :: o_s_lcl        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_lcl')
    254   type(ctrl_out),save :: o_s_therm      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_therm')
    255   !IM : Les champs suivants (s_capCL, s_oliqCL, s_cteiCL, s_trmb1, s_trmb2, s_trmb3) ne sont pas definis dans HBTM.F
    256   ! type(ctrl_out),save :: o_s_capCL      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_capCL')
    257   ! type(ctrl_out),save :: o_s_oliqCL     = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_oliqCL')
    258   ! type(ctrl_out),save :: o_s_cteiCL     = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_cteiCL')
    259   ! type(ctrl_out),save :: o_s_trmb1      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_trmb1')
    260   ! type(ctrl_out),save :: o_s_trmb2      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_trmb2')
    261   ! type(ctrl_out),save :: o_s_trmb3      = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'s_trmb3')
    262 
    263   type(ctrl_out),save :: o_slab_bils    = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'slab_bils_oce')
    264 
    265   type(ctrl_out),save :: o_ale_bl       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'ale_bl')
    266   type(ctrl_out),save :: o_alp_bl       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl')
    267   type(ctrl_out),save :: o_ale_wk       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'ale_wk')
    268   type(ctrl_out),save :: o_alp_wk       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_wk')
    269 
    270   type(ctrl_out),save :: o_ale          = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'ale')
    271   type(ctrl_out),save :: o_alp          = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp')
    272   type(ctrl_out),save :: o_cin          = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'cin')
    273   type(ctrl_out),save :: o_wape         = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'wape')
    274 
    275 !!! nrlmd le 10/04/2012
    276 
    277 !-------Spectre de thermiques de type 2 au LCL
    278   type(ctrl_out),save :: o_n2                = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'n2')
    279   type(ctrl_out),save :: o_s2                = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'s2')
    280                                                                              
    281 !-------Déclenchement stochastique                                           
    282   type(ctrl_out),save :: o_proba_notrig      = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'proba_notrig')
    283   type(ctrl_out),save :: o_random_notrig     = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'random_notrig')
    284   type(ctrl_out),save :: o_ale_bl_stat       = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'ale_bl_stat')
    285   type(ctrl_out),save :: o_ale_bl_trig       = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'ale_bl_trig')
    286 
    287 !-------Fermeture statistique
    288   type(ctrl_out),save :: o_alp_bl_det        = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_det')
    289   type(ctrl_out),save :: o_alp_bl_fluct_m    = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_fluct_m')
    290   type(ctrl_out),save :: o_alp_bl_fluct_tke  = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_fluct_tke')
    291   type(ctrl_out),save :: o_alp_bl_conv       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_conv')
    292   type(ctrl_out),save :: o_alp_bl_stat       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_stat')
    293 
    294 !!! fin nrlmd le 10/04/2012
    295 
    296   ! Champs interpolles sur des niveaux de pression ??? a faire correctement
    297 
    298   type(ctrl_out),save,dimension(7) :: o_uSTDlevs     = (/ ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u850'), &
    299        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u700'), &
    300        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u500'), &
    301        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u200'), &
    302        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u100'), &
    303        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u50'), &
    304        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'u10') /)
    305 
    306 
    307   type(ctrl_out),save,dimension(7) :: o_vSTDlevs     = (/ ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v850'), &
    308        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v700'), &
    309        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v500'), &
    310        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v200'), &
    311        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v100'), &
    312        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v50'), &
    313        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'v10') /)
    314 
    315   type(ctrl_out),save,dimension(7) :: o_wSTDlevs     = (/ ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w850'), &
    316        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w700'), &
    317        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w500'), &
    318        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w200'), &
    319        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w100'), &
    320        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w50'), &
    321        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'w10') /)
    322 
    323   type(ctrl_out),save,dimension(7) :: o_tSTDlevs     = (/ ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t850'), &
    324        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t700'), &
    325        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t500'), &
    326        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t200'), &
    327        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t100'), &
    328        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t50'), &
    329        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'t10') /)
    330 
    331   type(ctrl_out),save,dimension(7) :: o_qSTDlevs     = (/ ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q850'), &
    332        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q700'), &
    333        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q500'), &
    334        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q200'), &
    335        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q100'), &
    336        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q50'), &
    337        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'q10') /)
    338 
    339   type(ctrl_out),save,dimension(7) :: o_zSTDlevs   = (/ ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z850'), &
    340        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z700'), &
    341        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z500'), &
    342        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z200'), &
    343        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z100'), &
    344        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z50'), &
    345        ctrl_out((/ 1, 7, 7, 10, 10, 10 /),'z10') /)
    346 
    347 
    348   type(ctrl_out),save :: o_t_oce_sic    = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'t_oce_sic')
    349 
    350   type(ctrl_out),save :: o_weakinv      = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'weakinv')
    351   type(ctrl_out),save :: o_dthmin       = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'dthmin')
    352   type(ctrl_out),save,dimension(4) :: o_u10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'u10_ter'), &
    353        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'u10_lic'), &
    354        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'u10_oce'), &
    355        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'u10_sic') /)
    356 
    357   type(ctrl_out),save,dimension(4) :: o_v10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'v10_ter'), &
    358        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'v10_lic'), &
    359        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'v10_oce'), &
    360        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'v10_sic') /)
    361 
    362   type(ctrl_out),save :: o_cldtau       = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'cldtau')                     
    363   type(ctrl_out),save :: o_cldemi       = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'cldemi')
    364   type(ctrl_out),save :: o_rh2m         = ctrl_out((/ 5, 5, 10, 10, 10, 10 /),'rh2m')
    365   type(ctrl_out),save :: o_rh2m_min     = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'rh2m_min')
    366   type(ctrl_out),save :: o_rh2m_max     = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'rh2m_max')
    367   type(ctrl_out),save :: o_qsat2m       = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'qsat2m')
    368   type(ctrl_out),save :: o_tpot         = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'tpot')
    369   type(ctrl_out),save :: o_tpote        = ctrl_out((/ 10, 5, 10, 10, 10, 10 /),'tpote')
    370   type(ctrl_out),save :: o_tke          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tke ')
    371   type(ctrl_out),save :: o_tke_max      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tke_max')
    372 
    373   type(ctrl_out),save,dimension(4) :: o_tke_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_ter'), &
    374        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_lic'), &
    375        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_oce'), &
    376        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_sic') /)
    377 
    378   type(ctrl_out),save,dimension(4) :: o_tke_max_srf  = (/ ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_max_ter'), &
    379        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_max_lic'), &
    380        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_max_oce'), &
    381        ctrl_out((/ 10, 4, 10, 10, 10, 10 /),'tke_max_sic') /)
    382 
    383   type(ctrl_out),save :: o_kz           = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'kz')
    384   type(ctrl_out),save :: o_kz_max       = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'kz_max')
    385   type(ctrl_out),save :: o_SWnetOR      = ctrl_out((/ 10, 10, 2, 10, 10, 10 /),'SWnetOR')
    386   type(ctrl_out),save :: o_SWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10, 10 /),'SWdownOR')
    387   type(ctrl_out),save :: o_LWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10, 10 /),'LWdownOR')
    388 
    389   type(ctrl_out),save :: o_snowl        = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'snowl')
    390   type(ctrl_out),save :: o_cape_max     = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'cape_max')
    391   type(ctrl_out),save :: o_solldown     = ctrl_out((/ 10, 1, 10, 10, 10, 10 /),'solldown')
    392 
    393   type(ctrl_out),save :: o_dtsvdfo      = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dtsvdfo')
    394   type(ctrl_out),save :: o_dtsvdft      = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dtsvdft')
    395   type(ctrl_out),save :: o_dtsvdfg      = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dtsvdfg')
    396   type(ctrl_out),save :: o_dtsvdfi      = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dtsvdfi')
    397   type(ctrl_out),save :: o_rugs         = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'rugs')
    398 
    399   type(ctrl_out),save :: o_topswad      = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'topswad')
    400   type(ctrl_out),save :: o_topswad0     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'topswad0')
    401   type(ctrl_out),save :: o_topswai      = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'topswai')
    402   type(ctrl_out),save :: o_solswad      = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'solswad')
    403   type(ctrl_out),save :: o_solswad0     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'solswad0')
    404   type(ctrl_out),save :: o_solswai      = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'solswai')
    405 
    406   type(ctrl_out),save,dimension(10) :: o_tausumaero  = (/ ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_ASBCM'), &
    407        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_ASPOMM'), &
    408        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_ASSO4M'), &
    409        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_CSSO4M'), &
    410        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_SSSSM'), &
    411        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_ASSSM'), &
    412        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_CSSSM'), &
    413        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_CIDUSTM'), &
    414        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_AIBCM'), &
    415        ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'OD550_AIPOMM') /)
    416 
    417   type(ctrl_out),save :: o_od550aer     = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'od550aer')
    418   type(ctrl_out),save :: o_od865aer     = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'od865aer')
    419   type(ctrl_out),save :: o_absvisaer    = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'absvisaer')
    420   type(ctrl_out),save :: o_od550lt1aer  = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'od550lt1aer')
    421 
    422   type(ctrl_out),save :: o_sconcso4     = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'sconcso4')
    423   type(ctrl_out),save :: o_sconcoa      = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'sconcoa')
    424   type(ctrl_out),save :: o_sconcbc      = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'sconcbc')
    425   type(ctrl_out),save :: o_sconcss      = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'sconcss')
    426   type(ctrl_out),save :: o_sconcdust    = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'sconcdust')
    427   type(ctrl_out),save :: o_concso4      = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'concso4')
    428   type(ctrl_out),save :: o_concoa       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'concoa')
    429   type(ctrl_out),save :: o_concbc       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'concbc')
    430   type(ctrl_out),save :: o_concss       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'concss')
    431   type(ctrl_out),save :: o_concdust     = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'concdust')
    432   type(ctrl_out),save :: o_loadso4      = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'loadso4')
    433   type(ctrl_out),save :: o_loadoa       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'loadoa')
    434   type(ctrl_out),save :: o_loadbc       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'loadbc')
    435   type(ctrl_out),save :: o_loadss       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'loadss')
    436   type(ctrl_out),save :: o_loaddust     = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'loaddust')
    437 
    438   type(ctrl_out),save :: o_swtoaas_nat  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoaas_nat')
    439   type(ctrl_out),save :: o_swsrfas_nat  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfas_nat')
    440   type(ctrl_out),save :: o_swtoacs_nat  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoacs_nat')
    441   type(ctrl_out),save :: o_swsrfcs_nat  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfcs_nat')
    442 
    443   type(ctrl_out),save :: o_swtoaas_ant  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoaas_ant')
    444   type(ctrl_out),save :: o_swsrfas_ant  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfas_ant')
    445   type(ctrl_out),save :: o_swtoacs_ant  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoacs_ant')
    446   type(ctrl_out),save :: o_swsrfcs_ant  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfcs_ant')
    447 
    448   type(ctrl_out),save :: o_swtoacf_nat  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoacf_nat')
    449   type(ctrl_out),save :: o_swsrfcf_nat  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfcf_nat')
    450   type(ctrl_out),save :: o_swtoacf_ant  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoacf_ant')
    451   type(ctrl_out),save :: o_swsrfcf_ant  = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfcf_ant')
    452   type(ctrl_out),save :: o_swtoacf_zero = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swtoacf_zero')
    453   type(ctrl_out),save :: o_swsrfcf_zero = ctrl_out((/ 4, 6, 10, 10, 10, 10 /),'swsrfcf_zero')
    454 
    455   type(ctrl_out),save :: o_cldncl       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'cldncl')
    456   type(ctrl_out),save :: o_reffclwtop   = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'reffclwtop')
    457   type(ctrl_out),save :: o_cldnvi       = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'cldnvi')
    458   type(ctrl_out),save :: o_lcc          = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'lcc')
    459 
    460 
    461 !!!!!!!!!!!!!!!!!!!!!! 3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    462   type(ctrl_out),save :: o_ec550aer     = ctrl_out((/ 2, 6, 10, 10, 10, 10 /),'ec550aer')
    463   type(ctrl_out),save :: o_lwcon        = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'lwcon')
    464   type(ctrl_out),save :: o_iwcon        = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'iwcon')
    465   type(ctrl_out),save :: o_temp         = ctrl_out((/ 2, 3, 4, 10, 10, 10 /),'temp')
    466   type(ctrl_out),save :: o_theta        = ctrl_out((/ 2, 3, 4, 10, 10, 10 /),'theta')
    467   type(ctrl_out),save :: o_ovap         = ctrl_out((/ 2, 3, 4, 10, 10, 10 /),'ovap')
    468   type(ctrl_out),save :: o_ovapinit     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'ovapinit')
    469   type(ctrl_out),save :: o_oliq         = ctrl_out((/ 2, 3, 4, 10, 10, 10 /),'oliq')
    470   type(ctrl_out),save :: o_wvapp        = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'wvapp')
    471   type(ctrl_out),save :: o_geop         = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'geop')
    472   type(ctrl_out),save :: o_vitu         = ctrl_out((/ 2, 3, 4, 6, 10, 10 /),'vitu')
    473   type(ctrl_out),save :: o_vitv         = ctrl_out((/ 2, 3, 4, 6, 10, 10 /),'vitv')
    474   type(ctrl_out),save :: o_vitw         = ctrl_out((/ 2, 3, 10, 6, 10, 10 /),'vitw')
    475   type(ctrl_out),save :: o_pres         = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'pres')
    476   type(ctrl_out),save :: o_paprs        = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'paprs')
    477   type(ctrl_out),save :: o_mass        = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'mass')
    478   type(ctrl_out),save :: o_zfull       = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'zfull')
    479   type(ctrl_out),save :: o_zhalf       = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'zhalf')
    480   type(ctrl_out),save :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rneb')
    481   type(ctrl_out),save :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rnebcon')
    482   type(ctrl_out),save :: o_rnebls       = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rnebls')
    483   type(ctrl_out),save :: o_rhum         = ctrl_out((/ 2, 5, 10, 10, 10, 10 /),'rhum')
    484   type(ctrl_out),save :: o_ozone        = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'ozone')
    485   type(ctrl_out),save :: o_ozone_light  = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'ozone_daylight')
    486   type(ctrl_out),save :: o_upwd         = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'upwd')
    487   type(ctrl_out),save :: o_dtphy        = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'dtphy')
    488   type(ctrl_out),save :: o_dqphy        = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'dqphy')
    489   type(ctrl_out),save :: o_pr_con_l     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'pr_con_l')
    490   type(ctrl_out),save :: o_pr_con_i     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'pr_con_i')
    491   type(ctrl_out),save :: o_pr_lsc_l     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'pr_lsc_l')
    492   type(ctrl_out),save :: o_pr_lsc_i     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'pr_lsc_i')
    493   type(ctrl_out),save :: o_re           = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'re')
    494   type(ctrl_out),save :: o_fl           = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'fl')
    495   type(ctrl_out),save :: o_scdnc        = ctrl_out((/ 2,  6, 10, 10, 10, 10 /),'scdnc')
    496   type(ctrl_out),save :: o_reffclws     = ctrl_out((/ 2,  6, 10, 10, 10, 10 /),'reffclws')
    497   type(ctrl_out),save :: o_reffclwc     = ctrl_out((/ 2,  6, 10, 10, 10, 10 /),'reffclwc')
    498   type(ctrl_out),save :: o_lcc3d        = ctrl_out((/ 2,  6, 10, 10, 10, 10 /),'lcc3d')
    499   type(ctrl_out),save :: o_lcc3dcon     = ctrl_out((/ 2,  6, 10, 10, 10, 10 /),'lcc3dcon')
    500   type(ctrl_out),save :: o_lcc3dstra    = ctrl_out((/ 2,  6, 10, 10, 10, 10 /),'lcc3dstra')
    501 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    502 
    503   type(ctrl_out),save,dimension(4) :: o_albe_srf     = (/ ctrl_out((/ 3, 7, 10, 7, 10, 10 /),'albe_ter'), &
    504        ctrl_out((/ 3, 7, 10, 7, 10, 10 /),'albe_lic'), &
    505        ctrl_out((/ 3, 7, 10, 7, 10, 10 /),'albe_oce'), &
    506        ctrl_out((/ 3, 7, 10, 7, 10, 10 /),'albe_sic') /)
    507 
    508   type(ctrl_out),save,dimension(4) :: o_ages_srf     = (/ ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'ages_ter'), &
    509        ctrl_out((/ 3, 10, 10, 10, 10, 10 /),'ages_lic'), &
    510        ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'ages_oce'), &
    511        ctrl_out((/ 3, 10, 10, 10, 10, 10 /),'ages_sic') /)
    512 
    513   type(ctrl_out),save,dimension(4) :: o_rugs_srf     = (/ ctrl_out((/ 3, 6, 10, 10, 10, 10 /),'rugs_ter'), &
    514        ctrl_out((/ 3, 6, 10, 10, 10, 10 /),'rugs_lic'), &
    515        ctrl_out((/ 3, 6, 10, 10, 10, 10 /),'rugs_oce'), &
    516        ctrl_out((/ 3, 6, 10, 10, 10, 10 /),'rugs_sic') /)
    517 
    518   type(ctrl_out),save :: o_alb1         = ctrl_out((/ 3, 10, 10, 10, 10, 10 /),'alb1')
    519   type(ctrl_out),save :: o_alb2       = ctrl_out((/ 3, 10, 10, 10, 10, 10 /),'alb2')
    520 
    521   type(ctrl_out),save :: o_clwcon       = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'clwcon')
    522   type(ctrl_out),save :: o_Ma           = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'Ma')
    523   type(ctrl_out),save :: o_dnwd         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dnwd')
    524   type(ctrl_out),save :: o_dnwd0        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dnwd0')
    525   type(ctrl_out),save :: o_mc           = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'mc')
    526   type(ctrl_out),save :: o_ftime_con    = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ftime_con')
    527   type(ctrl_out),save :: o_dtdyn        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtdyn')
    528   type(ctrl_out),save :: o_dqdyn        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqdyn')
    529   type(ctrl_out),save :: o_dudyn        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dudyn')  !AXC
    530   type(ctrl_out),save :: o_dvdyn        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvdyn')  !AXC
    531   type(ctrl_out),save :: o_dtcon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtcon')
    532   type(ctrl_out),save :: o_ducon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ducon')
    533   type(ctrl_out),save :: o_dvcon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvcon')
    534   type(ctrl_out),save :: o_dqcon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqcon')
    535   type(ctrl_out),save :: o_dtwak        = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'dtwak')
    536   type(ctrl_out),save :: o_dqwak        = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'dqwak')
    537   type(ctrl_out),save :: o_wake_h       = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_h')
    538   type(ctrl_out),save :: o_wake_s       = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_s')
    539   type(ctrl_out),save :: o_wake_deltat  = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_deltat')
    540   type(ctrl_out),save :: o_wake_deltaq  = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_deltaq')
    541   type(ctrl_out),save :: o_wake_omg     = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'wake_omg')
    542   type(ctrl_out),save :: o_wdtrainA     = ctrl_out((/ 4, 1, 10,  4,  1, 10 /),'wdtrainA') !<<RomP
    543   type(ctrl_out),save :: o_wdtrainM     = ctrl_out((/ 4, 1, 10,  4,  1, 10 /),'wdtrainM') !<<RomP
    544   type(ctrl_out),save :: o_Vprecip      = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'Vprecip')
    545   type(ctrl_out),save :: o_ftd          = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'ftd')
    546   type(ctrl_out),save :: o_fqd          = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'fqd')
    547   type(ctrl_out),save :: o_dtlsc        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtlsc')
    548   type(ctrl_out),save :: o_dtlschr      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtlschr')
    549   type(ctrl_out),save :: o_dqlsc        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqlsc')
    550   type(ctrl_out),save :: o_beta_prec    = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'beta_prec')
    551   type(ctrl_out),save :: o_dtvdf        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtvdf')
    552   type(ctrl_out),save :: o_dqvdf        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqvdf')
    553   type(ctrl_out),save :: o_dteva        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dteva')
    554   type(ctrl_out),save :: o_dqeva        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqeva')
    555 
    556 !!!!!!!!!!!!!!!! Specifique thermiques
    557   type(ctrl_out),save :: o_dqlscth        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dqlscth')
    558   type(ctrl_out),save :: o_dqlscst        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dqlscst')
    559   type(ctrl_out),save :: o_dtlscth        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dtlscth')
    560   type(ctrl_out),save :: o_dtlscst        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'dtlscst')
    561   type(ctrl_out),save :: o_plulth        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'plulth')
    562   type(ctrl_out),save :: o_plulst        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'plulst')
    563   type(ctrl_out),save :: o_lmaxth        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'lmaxth')
    564   type(ctrl_out),save :: o_ptconvth        = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'ptconvth')
    565 !!!!!!!!!!!!!!!!!!!!!!!!
    566 
    567 
    568   type(ctrl_out),save :: o_ptconv       = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ptconv')
    569   type(ctrl_out),save :: o_ratqs        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ratqs')
    570   type(ctrl_out),save :: o_dtthe        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtthe')
    571   type(ctrl_out),save :: o_f_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'f_th')
    572   type(ctrl_out),save :: o_e_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'e_th')
    573   type(ctrl_out),save :: o_w_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'w_th')
    574   type(ctrl_out),save :: o_ftime_th     = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ftime_th')
    575   type(ctrl_out),save :: o_q_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'q_th')
    576   type(ctrl_out),save :: o_a_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'a_th')
    577   type(ctrl_out),save :: o_d_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'d_th')
    578   type(ctrl_out),save :: o_f0_th        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'f0_th')
    579   type(ctrl_out),save :: o_zmax_th      = ctrl_out((/ 4,  4,  4,  5, 10, 10 /),'zmax_th')
    580   type(ctrl_out),save :: o_dqthe        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqthe')
    581   type(ctrl_out),save :: o_dtajs        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtajs')
    582   type(ctrl_out),save :: o_dqajs        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqajs')
    583   type(ctrl_out),save :: o_dtswr        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtswr')
    584   type(ctrl_out),save :: o_dtsw0        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtsw0')
    585   type(ctrl_out),save :: o_dtlwr        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtlwr')
    586   type(ctrl_out),save :: o_dtlw0        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtlw0')
    587   type(ctrl_out),save :: o_dtec         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtec')
    588   type(ctrl_out),save :: o_duvdf        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'duvdf')
    589   type(ctrl_out),save :: o_dvvdf        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvvdf')
    590   type(ctrl_out),save :: o_duoro        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'duoro')
    591   type(ctrl_out),save :: o_dvoro        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvoro')
    592   type(ctrl_out),save :: o_dulif        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dulif')
    593   type(ctrl_out),save :: o_dvlif        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvlif')
    594   type(ctrl_out),save :: o_duhin        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'duhin')
    595   type(ctrl_out),save :: o_dvhin        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvhin')
    596   type(ctrl_out),save :: o_dtoro        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtoro')
    597   type(ctrl_out),save :: o_dtlif        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtlif')
    598   type(ctrl_out),save :: o_dthin        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dthin')
    599 
    600   type(ctrl_out),save,allocatable :: o_trac(:)
    601   type(ctrl_out),save,allocatable :: o_trac_cum(:)
    602 
    603   type(ctrl_out),save :: o_rsu        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rsu')
    604   type(ctrl_out),save :: o_rsd        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rsd')
    605   type(ctrl_out),save :: o_rlu        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rlu')
    606   type(ctrl_out),save :: o_rld        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rld')
    607   type(ctrl_out),save :: o_rsucs      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rsucs')
    608   type(ctrl_out),save :: o_rsdcs      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rsdcs')
    609   type(ctrl_out),save :: o_rlucs      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rlucs')
    610   type(ctrl_out),save :: o_rldcs      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rldcs')
    611 
    612   type(ctrl_out),save :: o_tnt          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tnt')
    613   type(ctrl_out),save :: o_tntc         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tntc')
    614   type(ctrl_out),save :: o_tntr        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tntr')
    615   type(ctrl_out),save :: o_tntscpbl          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tntscpbl')
    616 
    617   type(ctrl_out),save :: o_tnhus          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tnhus')
    618   type(ctrl_out),save :: o_tnhusc         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tnhusc')
    619   type(ctrl_out),save :: o_tnhusscpbl     = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'tnhusscpbl')
    620 
    621   type(ctrl_out),save :: o_evu          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'evu')
    622 
    623   type(ctrl_out),save :: o_h2o          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'h2o')
    624 
    625   type(ctrl_out),save :: o_mcd          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'mcd')
    626   type(ctrl_out),save :: o_dmc          = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dmc')
    627   type(ctrl_out),save :: o_ref_liq      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ref_liq')
    628   type(ctrl_out),save :: o_ref_ice      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ref_ice')
    629 
    630   type(ctrl_out),save :: o_rsut4co2     = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rsut4co2')
    631   type(ctrl_out),save :: o_rlut4co2     = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rlut4co2')
    632   type(ctrl_out),save :: o_rsutcs4co2   = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rsutcs4co2')
    633   type(ctrl_out),save :: o_rlutcs4co2   = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rlutcs4co2')
    634 
    635   type(ctrl_out),save :: o_rsu4co2     = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rsu4co2')
    636   type(ctrl_out),save :: o_rlu4co2     = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rlu4co2')
    637   type(ctrl_out),save :: o_rsucs4co2   = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rsucs4co2')
    638   type(ctrl_out),save :: o_rlucs4co2   = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rlucs4co2')
    639   type(ctrl_out),save :: o_rsd4co2     = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rsd4co2')
    640   type(ctrl_out),save :: o_rld4co2     = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rld4co2')
    641   type(ctrl_out),save :: o_rsdcs4co2   = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rsdcs4co2')
    642   type(ctrl_out),save :: o_rldcs4co2   = ctrl_out((/ 5, 10, 10, 10, 10, 10 /),'rldcs4co2')
     20  PRIVATE histdef2d, histdef3d, conf_physoutputs
     21
     22  REAL, PRIVATE, SAVE                :: zdtime
     23  !$OMP THREADPRIVATE(zdtime)
     24
    64325
    64426
    … …  
    65638       ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, read_climoz, &
    65739       phys_out_filestations, &
    658        new_aod, aerosol_couple)   
     40       new_aod, aerosol_couple, flag_aerosol_strat)   
    65941
    66042    USE iophy
    … …  
    66951    include "dimensions.h"
    67052    include "temps.h"
    671     include "indicesol.h"
    67253    include "clesphys.h"
    67354    include "thermcell.h"
    … …  
    67758    real,dimension(klon),intent(in) :: rlon
    67859    real,dimension(klon),intent(in) :: rlat
    679     integer, intent(in)             :: pim
     60    INTEGER, intent(in)             :: pim
    68061    INTEGER, DIMENSION(pim)            :: tabij
    68162    INTEGER,dimension(pim), intent(in) :: ipt, jpt
    … …  
    68364    REAL,dimension(pim,2) :: plat_bounds, plon_bounds
    68465
    685     integer                               :: jjmp1
    686     integer                               :: nbteta, nlevSTD, radpas
    687     logical                               :: ok_mensuel, ok_journe, ok_hf, ok_instan
    688     logical                               :: ok_LES,ok_ade,ok_aie
    689     logical                               :: new_aod, aerosol_couple
    690     integer, intent(in)::  read_climoz ! read ozone climatology
     66    INTEGER                               :: jjmp1
     67    INTEGER                               :: nbteta, nlevSTD, radpas
     68    LOGICAL                               :: ok_mensuel, ok_journe, ok_hf, ok_instan
     69    LOGICAL                               :: ok_LES,ok_ade,ok_aie,flag_aerosol_strat
     70    LOGICAL                               :: new_aod, aerosol_couple
     71    INTEGER, intent(in)::  read_climoz ! read ozone climatology
    69172    !     Allowed values are 0, 1 and 2
    69273    !     0: do not read an ozone climatology
    … …  
    69576    !     climatology and the daylight climatology
    69677
    697     real                                  :: dtime
    698     integer                               :: idayref
    699     real                                  :: zjulian
    700     real, dimension(klev)                 :: Ahyb, Bhyb, Alt
    701     character(len=4), dimension(nlevSTD)  :: clevSTD
    702     integer                               :: nsrf, k, iq, iiq, iff, i, j, ilev
    703     integer                               :: naero
    704     logical                               :: ok_veget
    705     integer                               :: iflag_pbl
    706     CHARACTER(len=4)                      :: bb2
    707     CHARACTER(len=2)                      :: bb3
    708     character(len=6)                      :: type_ocean
    709     CHARACTER(len=3)                      :: ctetaSTD(nbteta)
    710     real, dimension(nfiles)               :: ecrit_files
    711     CHARACTER(len=20), dimension(nfiles)  :: phys_out_filenames
    712     INTEGER, dimension(iim*jjmp1)         ::  ndex2d
    713     INTEGER, dimension(iim*jjmp1*klev)    :: ndex3d
    714     integer                               :: imin_ins, imax_ins
    715     integer                               :: jmin_ins, jmax_ins
    716     integer, dimension(nfiles)            :: phys_out_levmin, phys_out_levmax
    717     integer, dimension(nfiles)            :: phys_out_filelevels
    718     CHARACTER(len=20), dimension(nfiles)  :: type_ecri_files, phys_out_filetypes
    719     character(len=20), dimension(nfiles)  :: chtimestep   = (/ 'DefFreq', 'DefFreq','DefFreq', 'DefFreq', 'DefFreq', 'DefFreq' /)
    720     logical, dimension(nfiles)            :: phys_out_filekeys
    721     logical, dimension(nfiles)            :: phys_out_filestations
     78    REAL                                  :: dtime
     79    INTEGER                               :: idayref
     80    REAL                                  :: zjulian
     81    REAL, DIMENSION(klev)                 :: Ahyb, Bhyb, Alt
     82    CHARACTER(LEN=4), DIMENSION(nlevSTD)  :: clevSTD
     83    INTEGER                               :: nsrf, k, iq, iiq, iff, i, j, ilev
     84    INTEGER                               :: naero
     85    LOGICAL                               :: ok_veget
     86    INTEGER                               :: iflag_pbl
     87    CHARACTER(LEN=4)                      :: bb2
     88    CHARACTER(LEN=2)                      :: bb3
     89    CHARACTER(LEN=6)                      :: type_ocean
     90    CHARACTER(LEN=3)                      :: ctetaSTD(nbteta)
     91    REAL, DIMENSION(nfiles)               :: ecrit_files
     92    CHARACTER(LEN=20), DIMENSION(nfiles)  :: phys_out_filenames
     93    INTEGER, DIMENSION(iim*jjmp1)         ::  ndex2d
     94    INTEGER, DIMENSION(iim*jjmp1*klev)    :: ndex3d
     95    INTEGER                               :: imin_ins, imax_ins
     96    INTEGER                               :: jmin_ins, jmax_ins
     97    INTEGER, DIMENSION(nfiles)            :: phys_out_levmin, phys_out_levmax
     98    INTEGER, DIMENSION(nfiles)            :: phys_out_filelevels
     99    CHARACTER(LEN=20), DIMENSION(nfiles)  :: chtimestep   = (/ 'DefFreq', 'DefFreq','DefFreq', 'DefFreq', 'DefFreq', 'DefFreq' /)
     100    LOGICAL, DIMENSION(nfiles)            :: phys_out_filekeys
     101    LOGICAL, DIMENSION(nfiles)            :: phys_out_filestations
    722102
    723103!!!!!!!!!! stockage dans une region limitee pour chaque fichier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    724104    !                 entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
    725105
    726     logical, dimension(nfiles), save  :: phys_out_regfkey       = (/ .false., .false., .false.,  .false., .false., .false. /)
    727     real, dimension(nfiles), save     :: phys_out_lonmin        = (/   -180.,   -180.,   -180.,    -180.,   -180.,   -180. /)
    728     real, dimension(nfiles), save     :: phys_out_lonmax        = (/    180.,    180.,    180.,     180.,    180.,    180. /)
    729     real, dimension(nfiles), save     :: phys_out_latmin        = (/    -90.,    -90.,    -90.,     -90.,    -90.,    -90. /)
    730     real, dimension(nfiles), save     :: phys_out_latmax        = (/     90.,     90.,     90.,     90.,     90.,     90. /)
    731 
    732     write(lunout,*) 'Debut phys_output_mod.F90'
     106    LOGICAL, DIMENSION(nfiles), SAVE  :: phys_out_regfkey       = (/ .FALSE., .FALSE., .FALSE.,  .FALSE., .FALSE., .FALSE. /)
     107    REAL, DIMENSION(nfiles), SAVE     :: phys_out_lonmin        = (/   -180.,   -180.,   -180.,    -180.,   -180.,   -180. /)
     108    REAL, DIMENSION(nfiles), SAVE     :: phys_out_lonmax        = (/    180.,    180.,    180.,     180.,    180.,    180. /)
     109    REAL, DIMENSION(nfiles), SAVE     :: phys_out_latmin        = (/    -90.,    -90.,    -90.,     -90.,    -90.,    -90. /)
     110    REAL, DIMENSION(nfiles), SAVE     :: phys_out_latmax        = (/     90.,     90.,     90.,     90.,     90.,     90. /)
     111
     112    WRITE(lunout,*) 'Debut phys_output_mod.F90'
    733113    ! Initialisations (Valeurs par defaut
    734114
    735     if (.not. allocated(o_trac)) ALLOCATE(o_trac(nqtot))
    736     if (.not. allocated(o_trac_cum)) ALLOCATE(o_trac_cum(nqtot))
     115    IF (.NOT. ALLOCATED(o_trac)) ALLOCATE(o_trac(nqtot))
     116    IF (.NOT. ALLOCATED(o_trac_cum)) ALLOCATE(o_trac_cum(nqtot))
    737117
    738118    levmax = (/ klev, klev, klev, klev, klev, klev /)
    … …  
    783163    !! Lectures des parametres de sorties dans physiq.def
    784164
    785     call getin('phys_out_regfkey',phys_out_regfkey)
    786     call getin('phys_out_lonmin',phys_out_lonmin)
    787     call getin('phys_out_lonmax',phys_out_lonmax)
    788     call getin('phys_out_latmin',phys_out_latmin)
    789     call getin('phys_out_latmax',phys_out_latmax)
     165    CALL getin('phys_out_regfkey',phys_out_regfkey)
     166    CALL getin('phys_out_lonmin',phys_out_lonmin)
     167    CALL getin('phys_out_lonmax',phys_out_lonmax)
     168    CALL getin('phys_out_latmin',phys_out_latmin)
     169    CALL getin('phys_out_latmax',phys_out_latmax)
    790170    phys_out_levmin(:)=levmin(:)
    791     call getin('phys_out_levmin',levmin)
     171    CALL getin('phys_out_levmin',levmin)
    792172    phys_out_levmax(:)=levmax(:)
    793     call getin('phys_out_levmax',levmax)
    794     call getin('phys_out_filenames',phys_out_filenames)
     173    CALL getin('phys_out_levmax',levmax)
     174    CALL getin('phys_out_filenames',phys_out_filenames)
    795175    phys_out_filekeys(:)=clef_files(:)
    796     call getin('phys_out_filekeys',clef_files)
     176    CALL getin('phys_out_filekeys',clef_files)
    797177    phys_out_filestations(:)=clef_stations(:)
    798     call getin('phys_out_filestations',clef_stations)
     178    CALL getin('phys_out_filestations',clef_stations)
    799179    phys_out_filelevels(:)=lev_files(:)
    800     call getin('phys_out_filelevels',lev_files)
    801     call getin('phys_out_filetimesteps',chtimestep)
     180    CALL getin('phys_out_filelevels',lev_files)
     181    CALL getin('phys_out_filetimesteps',chtimestep)
    802182    phys_out_filetypes(:)=type_ecri(:)
    803     call getin('phys_out_filetypes',type_ecri)
     183    CALL getin('phys_out_filetypes',type_ecri)
    804184
    805185    type_ecri_files(:)=type_ecri(:)
    806186
    807     write(lunout,*)'phys_out_lonmin=',phys_out_lonmin
    808     write(lunout,*)'phys_out_lonmax=',phys_out_lonmax
    809     write(lunout,*)'phys_out_latmin=',phys_out_latmin
    810     write(lunout,*)'phys_out_latmax=',phys_out_latmax
    811     write(lunout,*)'phys_out_filenames=',phys_out_filenames
    812     write(lunout,*)'phys_out_filetypes=',type_ecri
    813     write(lunout,*)'phys_out_filekeys=',clef_files
    814     write(lunout,*)'phys_out_filestations=',clef_stations
    815     write(lunout,*)'phys_out_filelevels=',lev_files
     187    WRITE(lunout,*)'phys_out_lonmin=',phys_out_lonmin
     188    WRITE(lunout,*)'phys_out_lonmax=',phys_out_lonmax
     189    WRITE(lunout,*)'phys_out_latmin=',phys_out_latmin
     190    WRITE(lunout,*)'phys_out_latmax=',phys_out_latmax
     191    WRITE(lunout,*)'phys_out_filenames=',phys_out_filenames
     192    WRITE(lunout,*)'phys_out_filetypes=',type_ecri
     193    WRITE(lunout,*)'phys_out_filekeys=',clef_files
     194    WRITE(lunout,*)'phys_out_filestations=',clef_stations
     195    WRITE(lunout,*)'phys_out_filelevels=',lev_files
    816196
    817197!!!!!!!!!!!!!!!!!!!!!!! Boucle sur les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    823203
    824204    ! Calcul des Ahyb, Bhyb et Alt
    825     do k=1,klev
     205    DO k=1,klev
    826206       Ahyb(k)=(ap(k)+ap(k+1))/2.
    827207       Bhyb(k)=(bp(k)+bp(k+1))/2.
    828208       Alt(k)=log(preff/presnivs(k))*8.
    829     enddo
     209    ENDDO
    830210    !          if(prt_level.ge.1) then
    831     write(lunout,*)'Ap Hybrid = ',Ahyb(1:klev)
    832     write(lunout,*)'Bp Hybrid = ',Bhyb(1:klev)
    833     write(lunout,*)'Alt approx des couches pour une haut d echelle de 8km = ',Alt(1:klev)
     211    WRITE(lunout,*)'Ap Hybrid = ',Ahyb(1:klev)
     212    WRITE(lunout,*)'Bp Hybrid = ',Bhyb(1:klev)
     213    WRITE(lunout,*)'Alt approx des couches pour une haut d echelle de 8km = ',Alt(1:klev)
    834214    !          endif
    835215    DO iff=1,nfiles
    836216
    837217       ! Calculate ecrit_files for all files
    838        if ( chtimestep(iff).eq.'DefFreq' ) then
     218       IF ( chtimestep(iff).eq.'DefFreq' ) then
    839219          ! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf ...)*86400.
    840220          ecrit_files(iff)=ecrit_files(iff)*86400.
    841        else
    842           call convers_timesteps(chtimestep(iff),dtime,ecrit_files(iff))
    843        endif
    844        write(lunout,*)'ecrit_files(',iff,')= ',ecrit_files(iff)
     221       ELSE
     222          CALL convers_timesteps(chtimestep(iff),dtime,ecrit_files(iff))
     223       ENDIF
     224       WRITE(lunout,*)'ecrit_files(',iff,')= ',ecrit_files(iff)
    845225
    846226       zoutm(iff) = ecrit_files(iff) ! Frequence ou l on ecrit en seconde
    … …  
    862242!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
    863243!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    864           if (phys_out_regfkey(iff)) then
     244          IF (phys_out_regfkey(iff)) then
    865245
    866246             imin_ins=1
    … …  
    871251             ! correction abderr       
    872252             do i=1,iim
    873                 write(lunout,*)'io_lon(i)=',io_lon(i)
    874                 if (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
    875                 if (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
     253                WRITE(lunout,*)'io_lon(i)=',io_lon(i)
     254                IF (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
     255                IF (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
    876256             enddo
    877257
    878258             do j=1,jjmp1
    879                 write(lunout,*)'io_lat(j)=',io_lat(j)
    880                 if (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
    881                 if (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
     259                WRITE(lunout,*)'io_lat(j)=',io_lat(j)
     260                IF (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
     261                IF (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
    882262             enddo
    883263
    884              write(lunout,*)'On stoke le fichier histoire numero ',iff,' sur ', &
     264             WRITE(lunout,*)'On stoke le fichier histoire numero ',iff,' sur ', &
    885265                  imin_ins,imax_ins,jmin_ins,jmax_ins
    886              write(lunout,*)'longitudes : ', &
     266             WRITE(lunout,*)'longitudes : ', &
    887267                  io_lon(imin_ins),io_lon(imax_ins), &
    888268                  'latitudes : ', &
    … …  
    895275!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    896276             !IM fichiers stations
    897           else if (clef_stations(iff)) THEN
    898 
    899              write(lunout,*)'phys_output_mod phys_out_filenames=',phys_out_filenames(iff)
    900 
    901              call histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
     277          else IF (clef_stations(iff)) THEN
     278
     279             WRITE(lunout,*)'phys_output_mod phys_out_filenames=',phys_out_filenames(iff)
     280
     281             CALL histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
    902282                  phys_out_filenames(iff), &
    903283                  itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
    … …  
    935315          !                 1,preff,nvertp0(iff))
    936316!!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    937           IF (.NOT.clef_stations(iff)) THEN
    938              !
    939              !IM: there is no way to have one single value in a netcdf file
    940              !
    941              type_ecri(1) = 'once'
    942              type_ecri(2) = 'once'
    943              type_ecri(3) = 'once'
    944              type_ecri(4) = 'once'
    945              type_ecri(5) = 'once'
    946              type_ecri(6) = 'once'
    947              CALL histdef2d(iff,clef_stations(iff),o_aire%flag,o_aire%name,"Grid area", "-")
    948              CALL histdef2d(iff,clef_stations(iff),o_contfracATM%flag,o_contfracATM%name,"% sfce ter+lic", "-")
    949           ENDIF
    950           type_ecri(:) = type_ecri_files(:)
     317    CALL histdef2d(iff,o_aire)
     318    CALL histdef2d(iff,o_contfracATM)
    951319
    952320!!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    953           CALL histdef2d(iff,clef_stations(iff),o_phis%flag,o_phis%name,"Surface geop.height", "m2/s2" )
    954           CALL histdef2d(iff,clef_stations(iff),o_contfracOR%flag,o_contfracOR%name,"% sfce terre OR", "-" )
    955           CALL histdef2d(iff,clef_stations(iff),o_aireTER%flag,o_aireTER%name,"Grid area CONT", "-" )
    956           CALL histdef2d(iff,clef_stations(iff),o_flat%flag,o_flat%name, "Latent heat flux", "W/m2")
    957           CALL histdef2d(iff,clef_stations(iff),o_slp%flag,o_slp%name, "Sea Level Pressure", "Pa" )
    958           CALL histdef2d(iff,clef_stations(iff),o_tsol%flag,o_tsol%name, "Surface Temperature", "K")
    959           CALL histdef2d(iff,clef_stations(iff),o_t2m%flag,o_t2m%name, "Temperature 2m", "K" )
    960           IF (.NOT.clef_stations(iff)) THEN
    961              !
    962              !IM: there is no way to have one single value in a netcdf file
    963              !
    964              type_ecri(1) = 't_min(X)'
    965              type_ecri(2) = 't_min(X)'
    966              type_ecri(3) = 't_min(X)'
    967              type_ecri(4) = 't_min(X)'
    968              type_ecri(5) = 't_min(X)'
    969              type_ecri(6) = 't_min(X)'
    970              CALL histdef2d(iff,clef_stations(iff),o_t2m_min%flag,o_t2m_min%name, "Temp 2m min", "K" )
    971              type_ecri(1) = 't_max(X)'
    972              type_ecri(2) = 't_max(X)'
    973              type_ecri(3) = 't_max(X)'
    974              type_ecri(4) = 't_max(X)'
    975              type_ecri(5) = 't_max(X)'
    976              type_ecri(6) = 't_max(X)'
    977              CALL histdef2d(iff,clef_stations(iff),o_t2m_max%flag,o_t2m_max%name, "Temp 2m max", "K" )
    978           ENDIF
    979           type_ecri(:) = type_ecri_files(:)
    980           CALL histdef2d(iff,clef_stations(iff),o_wind10m%flag,o_wind10m%name, "10-m wind speed", "m/s")
    981           CALL histdef2d(iff,clef_stations(iff),o_wind10max%flag,o_wind10max%name, "10m wind speed max", "m/s")
    982           CALL histdef2d(iff,clef_stations(iff),o_sicf%flag,o_sicf%name, "Sea-ice fraction", "-" )
    983           CALL histdef2d(iff,clef_stations(iff),o_q2m%flag,o_q2m%name, "Specific humidity 2m", "kg/kg")
    984           CALL histdef2d(iff,clef_stations(iff),o_ustar%flag,o_ustar%name, "Friction velocity", "m/s" )
    985           CALL histdef2d(iff,clef_stations(iff),o_u10m%flag,o_u10m%name, "Vent zonal 10m", "m/s" )
    986           CALL histdef2d(iff,clef_stations(iff),o_v10m%flag,o_v10m%name, "Vent meridien 10m", "m/s")
    987           CALL histdef2d(iff,clef_stations(iff),o_psol%flag,o_psol%name, "Surface Pressure", "Pa" )
    988           CALL histdef2d(iff,clef_stations(iff),o_qsurf%flag,o_qsurf%name, "Surface Air humidity", "kg/kg")
    989 
    990           if (.not. ok_veget) then
    991              CALL histdef2d(iff,clef_stations(iff),o_qsol%flag,o_qsol%name, "Soil watter content", "mm" )
    992           endif
    993 
    994              type_ecri(1) = 'inst(X)'
    995              type_ecri(2) = 'inst(X)'
    996              type_ecri(3) = 'inst(X)'
    997              type_ecri(4) = 'inst(X)'
    998              type_ecri(5) = 'inst(X)'
    999              type_ecri(6) = 'inst(X)'
    1000           CALL histdef2d(iff,clef_stations(iff),o_ndayrain%flag,o_ndayrain%name, "Number of dayrain(liq+sol)", "-")
    1001              type_ecri(:) = type_ecri_files(:)
    1002           CALL histdef2d(iff,clef_stations(iff),o_precip%flag,o_precip%name, "Precip Totale liq+sol", "kg/(s*m2)" )
    1003           CALL histdef2d(iff,clef_stations(iff),o_plul%flag,o_plul%name, "Large-scale Precip.", "kg/(s*m2)")
    1004           CALL histdef2d(iff,clef_stations(iff),o_pluc%flag,o_pluc%name, "Convective Precip.", "kg/(s*m2)")
    1005           CALL histdef2d(iff,clef_stations(iff),o_snow%flag,o_snow%name, "Snow fall", "kg/(s*m2)" )
    1006           CALL histdef2d(iff,clef_stations(iff),o_msnow%flag,o_msnow%name, "Surface snow amount", "kg/m2" )
    1007           CALL histdef2d(iff,clef_stations(iff),o_fsnow%flag,o_fsnow%name, "Surface snow area fraction", "-" )
    1008           CALL histdef2d(iff,clef_stations(iff),o_evap%flag,o_evap%name, "Evaporat", "kg/(s*m2)" )
    1009           CALL histdef2d(iff,clef_stations(iff),o_tops%flag,o_tops%name, "Solar rad. at TOA", "W/m2")
    1010           CALL histdef2d(iff,clef_stations(iff),o_tops0%flag,o_tops0%name, "CS Solar rad. at TOA", "W/m2")
    1011           CALL histdef2d(iff,clef_stations(iff),o_topl%flag,o_topl%name, "IR rad. at TOA", "W/m2" )
    1012           CALL histdef2d(iff,clef_stations(iff),o_topl0%flag,o_topl0%name, "IR rad. at TOA", "W/m2")
    1013           CALL histdef2d(iff,clef_stations(iff),o_SWupTOA%flag,o_SWupTOA%name, "SWup at TOA", "W/m2")
    1014           CALL histdef2d(iff,clef_stations(iff),o_SWupTOAclr%flag,o_SWupTOAclr%name, "SWup clear sky at TOA", "W/m2")
    1015           CALL histdef2d(iff,clef_stations(iff),o_SWdnTOA%flag,o_SWdnTOA%name, "SWdn at TOA", "W/m2" )
    1016           CALL histdef2d(iff,clef_stations(iff),o_SWdnTOAclr%flag,o_SWdnTOAclr%name, "SWdn clear sky at TOA", "W/m2")
    1017           CALL histdef2d(iff,clef_stations(iff),o_nettop%flag,o_nettop%name, "Net dn radiatif flux at TOA", "W/m2")
    1018           CALL histdef2d(iff,clef_stations(iff),o_SWup200%flag,o_SWup200%name, "SWup at 200mb", "W/m2" )
    1019           CALL histdef2d(iff,clef_stations(iff),o_SWup200clr%flag,o_SWup200clr%name, "SWup clear sky at 200mb", "W/m2")
    1020           CALL histdef2d(iff,clef_stations(iff),o_SWdn200%flag,o_SWdn200%name, "SWdn at 200mb", "W/m2" )
    1021           CALL histdef2d(iff,clef_stations(iff),o_SWdn200clr%flag,o_SWdn200clr%name, "SWdn clear sky at 200mb", "W/m2")
    1022           CALL histdef2d(iff,clef_stations(iff),o_LWup200%flag,o_LWup200%name, "LWup at 200mb", "W/m2")
    1023           CALL histdef2d(iff,clef_stations(iff),o_LWup200clr%flag,o_LWup200clr%name, "LWup clear sky at 200mb", "W/m2")
    1024           CALL histdef2d(iff,clef_stations(iff),o_LWdn200%flag,o_LWdn200%name, "LWdn at 200mb", "W/m2")
    1025           CALL histdef2d(iff,clef_stations(iff),o_LWdn200clr%flag,o_LWdn200clr%name, "LWdn clear sky at 200mb", "W/m2")
    1026           CALL histdef2d(iff,clef_stations(iff),o_sols%flag,o_sols%name, "Solar rad. at surf.", "W/m2")
    1027           CALL histdef2d(iff,clef_stations(iff),o_sols0%flag,o_sols0%name, "Solar rad. at surf.", "W/m2")
    1028           CALL histdef2d(iff,clef_stations(iff),o_soll%flag,o_soll%name, "IR rad. at surface", "W/m2") 
    1029           CALL histdef2d(iff,clef_stations(iff),o_radsol%flag,o_radsol%name, "Rayonnement au sol", "W/m2")
    1030           CALL histdef2d(iff,clef_stations(iff),o_soll0%flag,o_soll0%name, "IR rad. at surface", "W/m2")
    1031           CALL histdef2d(iff,clef_stations(iff),o_SWupSFC%flag,o_SWupSFC%name, "SWup at surface", "W/m2")
    1032           CALL histdef2d(iff,clef_stations(iff),o_SWupSFCclr%flag,o_SWupSFCclr%name, "SWup clear sky at surface", "W/m2")
    1033           CALL histdef2d(iff,clef_stations(iff),o_SWdnSFC%flag,o_SWdnSFC%name, "SWdn at surface", "W/m2")
    1034           CALL histdef2d(iff,clef_stations(iff),o_SWdnSFCclr%flag,o_SWdnSFCclr%name, "SWdn clear sky at surface", "W/m2")
    1035           CALL histdef2d(iff,clef_stations(iff),o_LWupSFC%flag,o_LWupSFC%name, "Upwd. IR rad. at surface", "W/m2")
    1036           CALL histdef2d(iff,clef_stations(iff),o_LWdnSFC%flag,o_LWdnSFC%name, "Down. IR rad. at surface", "W/m2")
    1037           CALL histdef2d(iff,clef_stations(iff),o_LWupSFCclr%flag,o_LWupSFCclr%name, "CS Upwd. IR rad. at surface", "W/m2")
    1038           CALL histdef2d(iff,clef_stations(iff),o_LWdnSFCclr%flag,o_LWdnSFCclr%name, "Down. CS IR rad. at surface", "W/m2")
    1039           CALL histdef2d(iff,clef_stations(iff),o_bils%flag,o_bils%name, "Surf. total heat flux", "W/m2")
    1040           CALL histdef2d(iff,clef_stations(iff),o_sens%flag,o_sens%name, "Sensible heat flux", "W/m2")
    1041           CALL histdef2d(iff,clef_stations(iff),o_fder%flag,o_fder%name, "Heat flux derivation", "W/m2")
    1042           CALL histdef2d(iff,clef_stations(iff),o_ffonte%flag,o_ffonte%name, "Thermal flux for snow melting", "W/m2")
    1043           CALL histdef2d(iff,clef_stations(iff),o_fqcalving%flag,o_fqcalving%name, "Ice Calving", "kg/m2/s")
    1044           CALL histdef2d(iff,clef_stations(iff),o_fqfonte%flag,o_fqfonte%name, "Land ice melt", "kg/m2/s")
    1045 
    1046           CALL histdef2d(iff,clef_stations(iff),o_taux%flag,o_taux%name, "Zonal wind stress","Pa")
    1047           CALL histdef2d(iff,clef_stations(iff),o_tauy%flag,o_tauy%name, "Meridional wind stress","Pa")
    1048 
    1049           DO nsrf = 1, nbsrf
    1050              CALL histdef2d(iff,clef_stations(iff),o_pourc_srf(nsrf)%flag,o_pourc_srf(nsrf)%name,"% "//clnsurf(nsrf),"%")
    1051              CALL histdef2d(iff,clef_stations(iff),o_fract_srf(nsrf)%flag,o_fract_srf(nsrf)%name,"Fraction "//clnsurf(nsrf),"1")
    1052              CALL histdef2d(iff,clef_stations(iff), &
    1053                   o_taux_srf(nsrf)%flag,o_taux_srf(nsrf)%name,"Zonal wind stress"//clnsurf(nsrf),"Pa")
    1054              CALL histdef2d(iff,clef_stations(iff), &
    1055                   o_tauy_srf(nsrf)%flag,o_tauy_srf(nsrf)%name,"Meridional wind stress "//clnsurf(nsrf),"Pa")
    1056              CALL histdef2d(iff,clef_stations(iff), &
    1057                   o_tsol_srf(nsrf)%flag,o_tsol_srf(nsrf)%name,"Temperature "//clnsurf(nsrf),"K")
    1058              CALL histdef2d(iff,clef_stations(iff), &
    1059                   o_evappot_srf(nsrf)%flag,o_evappot_srf(nsrf)%name,"Temperature"//clnsurf(nsrf),"K")
    1060              CALL histdef2d(iff,clef_stations(iff), &
    1061                   o_ustar_srf(nsrf)%flag,o_ustar_srf(nsrf)%name,"Friction velocity "//clnsurf(nsrf),"m/s")
    1062              CALL histdef2d(iff,clef_stations(iff), &
    1063                   o_u10m_srf(nsrf)%flag,o_u10m_srf(nsrf)%name,"Vent Zonal 10m "//clnsurf(nsrf),"m/s")
    1064              CALL histdef2d(iff,clef_stations(iff), &
    1065                   o_evap_srf(nsrf)%flag,o_evap_srf(nsrf)%name,"evaporation at surface "//clnsurf(nsrf),"kg/(s*m2)")
    1066              CALL histdef2d(iff,clef_stations(iff), &
    1067                   o_v10m_srf(nsrf)%flag,o_v10m_srf(nsrf)%name,"Vent meredien 10m "//clnsurf(nsrf),"m/s")
    1068              CALL histdef2d(iff,clef_stations(iff), &
    1069                   o_t2m_srf(nsrf)%flag,o_t2m_srf(nsrf)%name,"Temp 2m "//clnsurf(nsrf),"K")
    1070              CALL histdef2d(iff,clef_stations(iff), &
    1071                   o_sens_srf(nsrf)%flag,o_sens_srf(nsrf)%name,"Sensible heat flux "//clnsurf(nsrf),"W/m2")
    1072              CALL histdef2d(iff,clef_stations(iff), &
    1073                   o_lat_srf(nsrf)%flag,o_lat_srf(nsrf)%name,"Latent heat flux "//clnsurf(nsrf),"W/m2")
    1074              CALL histdef2d(iff,clef_stations(iff), &
    1075                   o_flw_srf(nsrf)%flag,o_flw_srf(nsrf)%name,"LW "//clnsurf(nsrf),"W/m2")
    1076              CALL histdef2d(iff,clef_stations(iff), &
    1077                   o_fsw_srf(nsrf)%flag,o_fsw_srf(nsrf)%name,"SW "//clnsurf(nsrf),"W/m2")
    1078              CALL histdef2d(iff,clef_stations(iff), &
    1079                   o_wbils_srf(nsrf)%flag,o_wbils_srf(nsrf)%name,"Bilan sol "//clnsurf(nsrf),"W/m2" )
    1080              CALL histdef2d(iff,clef_stations(iff), &
    1081                   o_wbilo_srf(nsrf)%flag,o_wbilo_srf(nsrf)%name,"Bilan eau "//clnsurf(nsrf),"kg/(m2*s)")
    1082              if (iflag_pbl>1 .and. lev_files(iff).gt.10 ) then
    1083                 CALL histdef2d(iff,clef_stations(iff), &
    1084                      o_tke_srf(nsrf)%flag,o_tke_srf(nsrf)%name,"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
    1085 
    1086                 IF (.NOT.clef_stations(iff)) THEN
    1087                    !
    1088                    !IM: there is no way to have one single value in a netcdf file
    1089                    !
    1090                    type_ecri(1) = 't_max(X)'
    1091                    type_ecri(2) = 't_max(X)'
    1092                    type_ecri(3) = 't_max(X)'
    1093                    type_ecri(4) = 't_max(X)'
    1094                    type_ecri(5) = 't_max(X)'
    1095                    type_ecri(6) = 't_max(X)'
    1096                    CALL histdef2d(iff,clef_stations(iff), &
    1097                         o_tke_max_srf(nsrf)%flag,o_tke_max_srf(nsrf)%name,"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
    1098                    type_ecri(:) = type_ecri_files(:)
    1099                 ENDIF
    1100 
    1101              endif
    1102 
    1103              CALL histdef2d(iff,clef_stations(iff), &
    1104                   o_albe_srf(nsrf)%flag,o_albe_srf(nsrf)%name,"Albedo VIS surf. "//clnsurf(nsrf),"-")
    1105              CALL histdef2d(iff,clef_stations(iff), &
    1106                   o_rugs_srf(nsrf)%flag,o_rugs_srf(nsrf)%name,"Surface roughness "//clnsurf(nsrf),"m")
    1107              CALL histdef2d(iff,clef_stations(iff), &
    1108                   o_ages_srf(nsrf)%flag,o_ages_srf(nsrf)%name,"Snow age", "day")
    1109           END DO
    1110 
    1111           IF (new_aod .AND. (.NOT. aerosol_couple)) THEN
    1112              IF (ok_ade.OR.ok_aie) THEN
    1113 
    1114                 CALL histdef2d(iff,clef_stations(iff), &
    1115                      o_od550aer%flag,o_od550aer%name, "Total aerosol optical depth at 550nm", "-")
    1116                 CALL histdef2d(iff,clef_stations(iff), &
    1117                      o_od865aer%flag,o_od865aer%name, "Total aerosol optical depth at 870nm", "-")
    1118                 CALL histdef2d(iff,clef_stations(iff), &
    1119                      o_absvisaer%flag,o_absvisaer%name, "Absorption aerosol visible optical depth", "-")
    1120                 CALL histdef2d(iff,clef_stations(iff), &
    1121                      o_od550lt1aer%flag,o_od550lt1aer%name, "Fine mode optical depth", "-")
    1122 
    1123 
    1124                 CALL histdef2d(iff,clef_stations(iff), &
    1125                      o_sconcso4%flag,o_sconcso4%name,"Surface Concentration of Sulfate ","kg/m3")
    1126                 CALL histdef2d(iff,clef_stations(iff), &
    1127                      o_sconcoa%flag,o_sconcoa%name,"Surface Concentration of Organic Aerosol ","kg/m3")
    1128                 CALL histdef2d(iff,clef_stations(iff), &
    1129                      o_sconcbc%flag,o_sconcbc%name,"Surface Concentration of Black Carbon ","kg/m3")
    1130                 CALL histdef2d(iff,clef_stations(iff), &
    1131                      o_sconcss%flag,o_sconcss%name,"Surface Concentration of Sea Salt ","kg/m3")
    1132                 CALL histdef2d(iff,clef_stations(iff), &
    1133                      o_sconcdust%flag,o_sconcdust%name,"Surface Concentration of Dust ","kg/m3")
    1134                 CALL histdef3d(iff,clef_stations(iff), &
    1135                      o_concso4%flag,o_concso4%name,"Concentration of Sulfate ","kg/m3")
    1136                 CALL histdef3d(iff,clef_stations(iff), &
    1137                      o_concoa%flag,o_concoa%name,"Concentration of Organic Aerosol ","kg/m3")
    1138                 CALL histdef3d(iff,clef_stations(iff), &
    1139                      o_concbc%flag,o_concbc%name,"Concentration of Black Carbon ","kg/m3")
    1140                 CALL histdef3d(iff,clef_stations(iff), &
    1141                      o_concss%flag,o_concss%name,"Concentration of Sea Salt ","kg/m3")
    1142                 CALL histdef3d(iff,clef_stations(iff), &
    1143                      o_concdust%flag,o_concdust%name,"Concentration of Dust ","kg/m3")
    1144                 CALL histdef2d(iff,clef_stations(iff), &
    1145                      o_loadso4%flag,o_loadso4%name,"Column Load of Sulfate ","kg/m2")
    1146                 CALL histdef2d(iff,clef_stations(iff), &
    1147                      o_loadoa%flag,o_loadoa%name,"Column Load of Organic Aerosol ","kg/m2")
    1148                 CALL histdef2d(iff,clef_stations(iff), &
    1149                      o_loadbc%flag,o_loadbc%name,"Column Load of Black Carbon ","kg/m2")
    1150                 CALL histdef2d(iff,clef_stations(iff), &
    1151                      o_loadss%flag,o_loadss%name,"Column Load of Sea Salt ","kg/m2")
    1152                 CALL histdef2d(iff,clef_stations(iff), &
    1153                      o_loaddust%flag,o_loaddust%name,"Column Load of Dust ","kg/m2")
    1154 
    1155                 DO naero = 1, naero_spc
    1156                    CALL histdef2d(iff,clef_stations(iff), &
    1157                         o_tausumaero(naero)%flag,o_tausumaero(naero)%name,"Aerosol Optical depth at 550 nm "//name_aero(naero),"1")
    1158                 END DO
    1159              ENDIF
    1160           ENDIF
    1161 
    1162           IF (ok_ade) THEN
    1163              CALL histdef2d(iff,clef_stations(iff), &
    1164                   o_topswad%flag,o_topswad%name, "ADE at TOA", "W/m2")
    1165              CALL histdef2d(iff,clef_stations(iff), &
    1166                   o_topswad0%flag,o_topswad0%name, "ADE clear-sky at TOA", "W/m2")
    1167              CALL histdef2d(iff,clef_stations(iff), &
    1168                   o_solswad%flag,o_solswad%name, "ADE at SRF", "W/m2")
    1169              CALL histdef2d(iff,clef_stations(iff), &
    1170                   o_solswad0%flag,o_solswad0%name, "ADE clear-sky at SRF", "W/m2")
    1171 
    1172              CALL histdef2d(iff,clef_stations(iff), &
    1173                   o_swtoaas_nat%flag,o_swtoaas_nat%name, "Natural aerosol radiative forcing all-sky at TOA", "W/m2")
    1174              CALL histdef2d(iff,clef_stations(iff), &
    1175                   o_swsrfas_nat%flag,o_swsrfas_nat%name, "Natural aerosol radiative forcing all-sky at SRF", "W/m2")
    1176              CALL histdef2d(iff,clef_stations(iff), &
    1177                   o_swtoacs_nat%flag,o_swtoacs_nat%name, "Natural aerosol radiative forcing clear-sky at TOA", "W/m2")
    1178              CALL histdef2d(iff,clef_stations(iff), &
    1179                   o_swsrfcs_nat%flag,o_swsrfcs_nat%name, "Natural aerosol radiative forcing clear-sky at SRF", "W/m2")
    1180 
    1181              CALL histdef2d(iff,clef_stations(iff), &
    1182                   o_swtoaas_ant%flag,o_swtoaas_ant%name, "Anthropogenic aerosol radiative forcing all-sky at TOA", "W/m2")
    1183              CALL histdef2d(iff,clef_stations(iff), &
    1184                   o_swsrfas_ant%flag,o_swsrfas_ant%name, "Anthropogenic aerosol radiative forcing all-sky at SRF", "W/m2")
    1185              CALL histdef2d(iff,clef_stations(iff), &
    1186                   o_swtoacs_ant%flag,o_swtoacs_ant%name, "Anthropogenic aerosol radiative forcing clear-sky at TOA", "W/m2")
    1187              CALL histdef2d(iff,clef_stations(iff), &
    1188                   o_swsrfcs_ant%flag,o_swsrfcs_ant%name, "Anthropogenic aerosol radiative forcing clear-sky at SRF", "W/m2")
    1189 
    1190              IF (.NOT. aerosol_couple) THEN
    1191                 CALL histdef2d(iff,clef_stations(iff), &
    1192                      o_swtoacf_nat%flag,o_swtoacf_nat%name, "Natural aerosol impact on cloud radiative forcing at TOA", "W/m2")
    1193                 CALL histdef2d(iff,clef_stations(iff), &
    1194                      o_swsrfcf_nat%flag,o_swsrfcf_nat%name, "Natural aerosol impact on cloud radiative forcing  at SRF", "W/m2")
    1195                 CALL histdef2d(iff, clef_stations(iff), o_swtoacf_ant%flag, &
    1196                      o_swtoacf_ant%name, &
    1197                      "Anthropogenic aerosol impact on cloud radiative forcing at TOA", &
    1198                      "W/m2")
    1199                 CALL histdef2d(iff, clef_stations(iff), o_swsrfcf_ant%flag, &
    1200                      o_swsrfcf_ant%name, &
    1201                      "Anthropogenic aerosol impact on cloud radiative forcing at SRF", &
    1202                      "W/m2")
    1203                 CALL histdef2d(iff,clef_stations(iff), &
    1204                      o_swtoacf_zero%flag,o_swtoacf_zero%name, "Cloud radiative forcing (allsky-clearsky fluxes) at TOA", "W/m2")
    1205                 CALL histdef2d(iff,clef_stations(iff), &
    1206                      o_swsrfcf_zero%flag,o_swsrfcf_zero%name, "Cloud radiative forcing (allsky-clearsky fluxes) at SRF", "W/m2")
    1207              ENDIF
    1208           ENDIF
    1209 
    1210           IF (ok_aie) THEN
    1211              CALL histdef2d(iff,clef_stations(iff), &
    1212                   o_topswai%flag,o_topswai%name, "AIE at TOA", "W/m2")
    1213              CALL histdef2d(iff,clef_stations(iff), &
    1214                   o_solswai%flag,o_solswai%name, "AIE at SFR", "W/m2")
    1215              !Cloud droplet number concentration
    1216              CALL histdef3d(iff,clef_stations(iff), &
    1217                   o_scdnc%flag,o_scdnc%name, "Cloud droplet number concentration","m-3")
    1218              CALL histdef2d(iff,clef_stations(iff), &
    1219                   o_cldncl%flag,o_cldncl%name, "CDNC at top of liquid water cloud", "m-3")
    1220              CALL histdef3d(iff,clef_stations(iff), &
    1221                   o_reffclws%flag,o_reffclws%name, "Stratiform Cloud Droplet Effective Radius (aerosol diags.)","m")
    1222              CALL histdef3d(iff,clef_stations(iff), &
    1223                   o_reffclwc%flag,o_reffclwc%name, "Convective Cloud Droplet Effective Radius (aerosol diags.)","m")
    1224              CALL histdef2d(iff,clef_stations(iff), &
    1225                   o_cldnvi%flag,o_cldnvi%name, "Column Integrated Cloud Droplet Number", "m-2")
    1226              CALL histdef3d(iff,clef_stations(iff), &
    1227                   o_lcc3d%flag,o_lcc3d%name, "Cloud liquid fraction","1")
    1228              CALL histdef3d(iff,clef_stations(iff), &
    1229                   o_lcc3dcon%flag,o_lcc3dcon%name, "Convective cloud liquid fraction","1")
    1230              CALL histdef3d(iff,clef_stations(iff), &
    1231                   o_lcc3dstra%flag,o_lcc3dstra%name, "Stratiform cloud liquid fraction","1")
    1232              CALL histdef2d(iff,clef_stations(iff), &
    1233                   o_lcc%flag,o_lcc%name, "Cloud liquid fraction at top of cloud","1")
    1234              CALL histdef2d(iff,clef_stations(iff), &
    1235                   o_reffclwtop%flag,o_reffclwtop%name, "Droplet effective radius at top of liquid water cloud", "m")
    1236           ENDIF
    1237 
    1238 
    1239           CALL histdef2d(iff,clef_stations(iff), &
    1240                o_alb1%flag,o_alb1%name, "Surface VIS albedo", "-")
    1241           CALL histdef2d(iff,clef_stations(iff), &
    1242                o_alb2%flag,o_alb2%name, "Surface Near IR albedo", "-")
    1243           CALL histdef2d(iff,clef_stations(iff), &
    1244                o_cdrm%flag,o_cdrm%name, "Momentum drag coef.", "-")
    1245           CALL histdef2d(iff,clef_stations(iff), &
    1246                o_cdrh%flag,o_cdrh%name, "Heat drag coef.", "-" )
    1247           CALL histdef2d(iff,clef_stations(iff), &
    1248                o_cldl%flag,o_cldl%name, "Low-level cloudiness", "-")
    1249           CALL histdef2d(iff,clef_stations(iff), &
    1250                o_cldm%flag,o_cldm%name, "Mid-level cloudiness", "-")
    1251           CALL histdef2d(iff,clef_stations(iff), &
    1252                o_cldh%flag,o_cldh%name, "High-level cloudiness", "-")
    1253           CALL histdef2d(iff,clef_stations(iff), &
    1254                o_cldt%flag,o_cldt%name, "Total cloudiness", "-")
    1255           CALL histdef2d(iff,clef_stations(iff), &
    1256                o_cldq%flag,o_cldq%name, "Cloud liquid water path", "kg/m2")
    1257           CALL histdef2d(iff,clef_stations(iff), &
    1258                o_lwp%flag,o_lwp%name, "Cloud water path", "kg/m2")
    1259           CALL histdef2d(iff,clef_stations(iff), &
    1260                o_iwp%flag,o_iwp%name, "Cloud ice water path", "kg/m2" )
    1261           CALL histdef2d(iff,clef_stations(iff), &
    1262                o_ue%flag,o_ue%name, "Zonal energy transport", "-")
    1263           CALL histdef2d(iff,clef_stations(iff), &
    1264                o_ve%flag,o_ve%name, "Merid energy transport", "-")
    1265           CALL histdef2d(iff,clef_stations(iff), &
    1266                o_uq%flag,o_uq%name, "Zonal humidity transport", "-")
    1267           CALL histdef2d(iff,clef_stations(iff), &
    1268                o_vq%flag,o_vq%name, "Merid humidity transport", "-")
    1269 
    1270           IF(iflag_con.GE.3) THEN ! sb
    1271              CALL histdef2d(iff,clef_stations(iff), &
    1272                   o_cape%flag,o_cape%name, "Conv avlbl pot ener", "J/kg")
    1273              CALL histdef2d(iff,clef_stations(iff), &
    1274                   o_pbase%flag,o_pbase%name, "Cld base pressure", "Pa")
    1275              CALL histdef2d(iff,clef_stations(iff), &
    1276                   o_ptop%flag,o_ptop%name, "Cld top pressure", "Pa")
    1277              CALL histdef2d(iff,clef_stations(iff), &
    1278                   o_fbase%flag,o_fbase%name, "Cld base mass flux", "kg/m2/s")
    1279              if (iflag_con /= 30) then
    1280                 CALL histdef2d(iff,clef_stations(iff), &
    1281                      o_plcl%flag,o_plcl%name, "Lifting Condensation Level", "hPa")
    1282                 CALL histdef2d(iff,clef_stations(iff), &
    1283                      o_plfc%flag,o_plfc%name, "Level of Free Convection", "hPa")
    1284                 CALL histdef2d(iff,clef_stations(iff), &
    1285                      o_wbeff%flag,o_wbeff%name, "Conv. updraft velocity at LFC (<100)", "m/s")
    1286              end if
    1287              IF (.NOT.clef_stations(iff)) THEN
    1288                 !
    1289                 !IM: there is no way to have one single value in a netcdf file
    1290                 !
    1291                 type_ecri(1) = 't_max(X)'
    1292                 type_ecri(2) = 't_max(X)'
    1293                 type_ecri(3) = 't_max(X)'
    1294                 type_ecri(4) = 't_max(X)'
    1295                 type_ecri(5) = 't_max(X)'
    1296                 type_ecri(6) = 't_max(X)'
    1297                 CALL histdef2d(iff,clef_stations(iff), &
    1298                      o_cape_max%flag,o_cape_max%name, "CAPE max.", "J/kg")
    1299              ENDIF
    1300              type_ecri(:) = type_ecri_files(:)
    1301              CALL histdef3d(iff,clef_stations(iff), &
    1302                   o_upwd%flag,o_upwd%name, "saturated updraft", "kg/m2/s")
    1303              CALL histdef3d(iff,clef_stations(iff), &
    1304                   o_Ma%flag,o_Ma%name, "undilute adiab updraft", "kg/m2/s")
    1305              CALL histdef3d(iff,clef_stations(iff), &
    1306                   o_dnwd%flag,o_dnwd%name, "saturated downdraft", "kg/m2/s")
    1307              CALL histdef3d(iff,clef_stations(iff), &
    1308                   o_dnwd0%flag,o_dnwd0%name, "unsat. downdraft", "kg/m2/s")
    1309              CALL histdef3d(iff,clef_stations(iff), &
    1310                   o_mc%flag,o_mc%name, "Convective mass flux", "kg/m2/s")
    1311              type_ecri(1) = 'inst(X)'
    1312              type_ecri(2) = 'inst(X)'
    1313              type_ecri(3) = 'inst(X)'
    1314              type_ecri(4) = 'inst(X)'
    1315              type_ecri(5) = 'inst(X)'
    1316              type_ecri(6) = 'inst(X)'
    1317              CALL histdef2d(iff,clef_stations(iff), &
    1318                   o_ftime_con%flag,o_ftime_con%name, "Fraction of time convection Occurs", " ")
    1319              type_ecri(:) = type_ecri_files(:)
    1320           ENDIF !iflag_con .GE. 3
    1321 
    1322           CALL histdef2d(iff,clef_stations(iff), &
    1323                o_prw%flag,o_prw%name, "Precipitable water", "kg/m2")
    1324           CALL histdef2d(iff,clef_stations(iff), &
    1325                o_s_pblh%flag,o_s_pblh%name, "Boundary Layer Height", "m")
    1326           CALL histdef2d(iff,clef_stations(iff), &
    1327                o_s_pblt%flag,o_s_pblt%name, "t at Boundary Layer Height", "K")
    1328           CALL histdef2d(iff,clef_stations(iff), &
    1329                o_s_lcl%flag,o_s_lcl%name, "Condensation level", "m")
    1330           CALL histdef2d(iff,clef_stations(iff), &
    1331                o_s_therm%flag,o_s_therm%name, "Exces du thermique", "K")
     321    CALL histdef2d(iff,o_phis)
     322    CALL histdef2d(iff,o_contfracOR)
     323    CALL histdef2d(iff,o_aireTER)
     324    CALL histdef2d(iff,o_flat)
     325    CALL histdef2d(iff,o_slp)
     326    CALL histdef2d(iff,o_tsol)
     327    CALL histdef2d(iff,o_t2m)
     328    CALL histdef2d(iff,o_t2m_min)
     329    CALL histdef2d(iff,o_t2m_max)
     330    CALL histdef2d(iff,o_wind10m)
     331    CALL histdef2d(iff,o_wind10max)
     332    CALL histdef2d(iff,o_sicf)
     333    CALL histdef2d(iff,o_q2m)
     334    CALL histdef2d(iff,o_ustar)
     335    CALL histdef2d(iff,o_u10m)
     336    CALL histdef2d(iff,o_v10m)
     337    CALL histdef2d(iff,o_psol)
     338    CALL histdef2d(iff,o_qsurf)
     339
     340    IF (.NOT. ok_veget) THEN
     341      CALL histdef2d(iff,o_qsol)
     342    ENDIF
     343    CALL histdef2d(iff,o_ndayrain)
     344    CALL histdef2d(iff,o_precip)
     345    CALL histdef2d(iff,o_plul)
     346    CALL histdef2d(iff,o_pluc)
     347    CALL histdef2d(iff,o_snow)
     348    CALL histdef2d(iff,o_msnow)
     349    CALL histdef2d(iff,o_fsnow)
     350    CALL histdef2d(iff,o_evap)
     351    CALL histdef2d(iff,o_tops)
     352    CALL histdef2d(iff,o_tops0)
     353    CALL histdef2d(iff,o_topl)
     354    CALL histdef2d(iff,o_topl0)
     355    CALL histdef2d(iff,o_SWupTOA)
     356    CALL histdef2d(iff,o_SWupTOAclr)
     357    CALL histdef2d(iff,o_SWdnTOA)
     358    CALL histdef2d(iff,o_SWdnTOAclr)
     359    CALL histdef2d(iff,o_nettop)
     360    CALL histdef2d(iff,o_SWup200)
     361    CALL histdef2d(iff,o_SWup200clr)
     362    CALL histdef2d(iff,o_SWdn200)
     363    CALL histdef2d(iff,o_SWdn200clr)
     364    CALL histdef2d(iff,o_LWup200)
     365    CALL histdef2d(iff,o_LWup200clr)
     366    CALL histdef2d(iff,o_LWdn200)
     367    CALL histdef2d(iff,o_LWdn200clr)
     368    CALL histdef2d(iff,o_sols)
     369    CALL histdef2d(iff,o_sols0)
     370    CALL histdef2d(iff,o_soll)
     371    CALL histdef2d(iff,o_radsol)
     372    CALL histdef2d(iff,o_soll0)
     373    CALL histdef2d(iff,o_SWupSFC)
     374    CALL histdef2d(iff,o_SWupSFCclr)
     375    CALL histdef2d(iff,o_SWdnSFC)
     376    CALL histdef2d(iff,o_SWdnSFCclr)
     377    CALL histdef2d(iff,o_LWupSFC)
     378    CALL histdef2d(iff,o_LWdnSFC)
     379    CALL histdef2d(iff,o_LWupSFCclr)
     380    CALL histdef2d(iff,o_LWdnSFCclr)
     381    CALL histdef2d(iff,o_bils)
     382    CALL histdef2d(iff,o_bils_ec)
     383    CALL histdef2d(iff,o_bils_tke)
     384    CALL histdef2d(iff,o_bils_diss)
     385    CALL histdef2d(iff,o_bils_kinetic)
     386    CALL histdef2d(iff,o_bils_enthalp)
     387    CALL histdef2d(iff,o_bils_latent)
     388    CALL histdef2d(iff,o_sens)
     389    CALL histdef2d(iff,o_fder)
     390    CALL histdef2d(iff,o_ffonte)
     391    CALL histdef2d(iff,o_fqcalving)
     392    CALL histdef2d(iff,o_fqfonte)
     393    CALL histdef2d(iff,o_taux)
     394    CALL histdef2d(iff,o_tauy)
     395
     396    DO nsrf = 1, nbsrf
     397      CALL histdef2d(iff,o_pourc_srf(nsrf))
     398      CALL histdef2d(iff,o_fract_srf(nsrf))
     399      CALL histdef2d(iff, o_taux_srf(nsrf))
     400      CALL histdef2d(iff, o_tauy_srf(nsrf))
     401      CALL histdef2d(iff, o_tsol_srf(nsrf))
     402      CALL histdef2d(iff, o_evappot_srf(nsrf))
     403      CALL histdef2d(iff, o_ustar_srf(nsrf))
     404      CALL histdef2d(iff, o_u10m_srf(nsrf))
     405      CALL histdef2d(iff, o_evap_srf(nsrf))
     406      CALL histdef2d(iff, o_v10m_srf(nsrf))
     407      CALL histdef2d(iff, o_t2m_srf(nsrf))
     408      CALL histdef2d(iff, o_sens_srf(nsrf))
     409      CALL histdef2d(iff, o_lat_srf(nsrf))
     410      CALL histdef2d(iff, o_flw_srf(nsrf))
     411      CALL histdef2d(iff, o_fsw_srf(nsrf))
     412      CALL histdef2d(iff, o_wbils_srf(nsrf))
     413      CALL histdef2d(iff, o_wbilo_srf(nsrf))
     414      IF (iflag_pbl>1 ) then
     415            CALL histdef2d(iff, o_tke_srf(nsrf))
     416            CALL histdef2d(iff, o_tke_max_srf(nsrf))
     417      ENDIF
     418
     419      CALL histdef2d(iff, o_albe_srf(nsrf))
     420      CALL histdef2d(iff, o_rugs_srf(nsrf))
     421      CALL histdef2d(iff, o_ages_srf(nsrf))
     422    END DO
     423
     424    IF (new_aod .AND. (.NOT. aerosol_couple)) THEN
     425      IF (ok_ade.OR.ok_aie) THEN
     426          CALL histdef2d(iff,o_od550aer)
     427          CALL histdef2d(iff,o_od865aer)
     428          CALL histdef2d(iff,o_absvisaer)
     429          CALL histdef2d(iff,o_od550lt1aer)
     430          CALL histdef2d(iff,o_sconcso4)
     431          CALL histdef2d(iff,o_sconcoa)
     432          CALL histdef2d(iff,o_sconcbc)
     433          CALL histdef2d(iff,o_sconcss)
     434          CALL histdef2d(iff,o_sconcdust)
     435          CALL histdef3d(iff,o_concso4)
     436          CALL histdef3d(iff,o_concoa)
     437          CALL histdef3d(iff,o_concbc)
     438          CALL histdef3d(iff,o_concss)
     439          CALL histdef3d(iff,o_concdust)
     440          CALL histdef2d(iff,o_loadso4)
     441          CALL histdef2d(iff,o_loadoa)
     442          CALL histdef2d(iff,o_loadbc)
     443          CALL histdef2d(iff,o_loadss)
     444          CALL histdef2d(iff,o_loaddust)
     445!--STRAT AER
     446      ENDIF
     447      IF (ok_ade.OR.ok_aie.OR.flag_aerosol_strat) THEN
     448        DO naero = 1, naero_spc
     449          CALL histdef2d(iff, o_tausumaero(naero))
     450        END DO
     451      ENDIF
     452    ENDIF
     453
     454    IF (ok_ade) THEN
     455      CALL histdef2d(iff,o_topswad)
     456      CALL histdef2d(iff,o_topswad0)
     457      CALL histdef2d(iff,o_solswad)
     458      CALL histdef2d(iff,o_solswad0)
     459      CALL histdef2d(iff,o_swtoaas_nat)
     460      CALL histdef2d(iff,o_swsrfas_nat)
     461      CALL histdef2d(iff,o_swtoacs_nat)
     462      CALL histdef2d(iff,o_swsrfcs_nat)
     463      CALL histdef2d(iff,o_swtoaas_ant)
     464      CALL histdef2d(iff,o_swsrfas_ant)
     465      CALL histdef2d(iff,o_swtoacs_ant)
     466      CALL histdef2d(iff,o_swsrfcs_ant)
     467
     468      IF (.NOT. aerosol_couple) THEN
     469            CALL histdef2d(iff,o_swtoacf_nat)
     470            CALL histdef2d(iff,o_swsrfcf_nat)
     471            CALL histdef2d(iff,o_swtoacf_ant)
     472            CALL histdef2d(iff,o_swsrfcf_ant)
     473            CALL histdef2d(iff,o_swtoacf_zero)
     474            CALL histdef2d(iff,o_swsrfcf_zero)
     475      ENDIF
     476    ENDIF
     477
     478    IF (ok_aie) THEN
     479      CALL histdef2d(iff,o_topswai)
     480      CALL histdef2d(iff,o_solswai)
     481                  !Cloud droplet number concentration
     482      CALL histdef3d(iff,o_scdnc)
     483      CALL histdef2d(iff,o_cldncl)
     484      CALL histdef3d(iff,o_reffclws)
     485      CALL histdef3d(iff,o_reffclwc)
     486      CALL histdef2d(iff,o_cldnvi)
     487      CALL histdef3d(iff,o_lcc3d)
     488      CALL histdef3d(iff,o_lcc3dcon)
     489      CALL histdef3d(iff,o_lcc3dstra)
     490      CALL histdef2d(iff,o_lcc)
     491      CALL histdef2d(iff,o_reffclwtop)
     492    ENDIF
     493    CALL histdef2d(iff,o_alb1)
     494    CALL histdef2d(iff,o_alb2)
     495    CALL histdef2d(iff,o_cdrm)
     496    CALL histdef2d(iff,o_cdrh)
     497    CALL histdef2d(iff,o_cldl)
     498    CALL histdef2d(iff,o_cldm)
     499    CALL histdef2d(iff,o_cldh)
     500    CALL histdef2d(iff,o_cldt)
     501    CALL histdef2d(iff,o_cldq)
     502    CALL histdef2d(iff,o_lwp)
     503    CALL histdef2d(iff,o_iwp)
     504    CALL histdef2d(iff,o_ue)
     505    CALL histdef2d(iff,o_ve)
     506    CALL histdef2d(iff,o_uq)
     507    CALL histdef2d(iff,o_vq)
     508
     509    IF(iflag_con.GE.3) THEN ! sb
     510      CALL histdef2d(iff,o_cape)
     511      CALL histdef2d(iff,o_pbase)
     512      CALL histdef2d(iff,o_ptop)
     513      CALL histdef2d(iff,o_fbase)
     514      IF (iflag_con /= 30) THEN
     515            CALL histdef2d(iff,o_plcl)
     516            CALL histdef2d(iff,o_plfc)
     517            CALL histdef2d(iff,o_wbeff)
     518      ENDIF
     519      CALL histdef2d(iff,o_cape_max)
     520      CALL histdef3d(iff,o_upwd)
     521      CALL histdef3d(iff,o_Ma)
     522      CALL histdef3d(iff,o_dnwd)
     523      CALL histdef3d(iff,o_dnwd0)
     524      CALL histdef3d(iff,o_mc)
     525      CALL histdef2d(iff,o_ftime_con)
     526    ENDIF !iflag_con .GE. 3
     527    CALL histdef2d(iff,o_prw)
     528    CALL histdef2d(iff,o_s_pblh)
     529    CALL histdef2d(iff,o_s_pblt)
     530    CALL histdef2d(iff,o_s_lcl)
     531    CALL histdef2d(iff,o_s_therm)
    1332532          !IM : Les champs suivants (s_oliqCL, s_cteiCL, s_trmb1, s_trmb2, s_trmb3) ne sont pas definis dans HBTM.F
    1333           !CALL histdef2d(iff,clef_stations(iff), &
     533          !CALL histdef2d(iff, &
    1334534          !o_s_capCL%flag,o_s_capCL%name, "Conv avlbl pot enerfor ABL", "J/m2" )
    1335           !CALL histdef2d(iff,clef_stations(iff), &
     535          !CALL histdef2d(iff, &
    1336536          !o_s_oliqCL%flag,o_s_oliqCL%name, "Liq Water in BL", "kg/m2")
    1337           !CALL histdef2d(iff,clef_stations(iff), &
     537          !CALL histdef2d(iff, &
    1338538          !o_s_cteiCL%flag,o_s_cteiCL%name, "Instability criteria(ABL)", "K")
    1339           !CALL histdef2d(iff,clef_stations(iff), &
     539          !CALL histdef2d(iff, &
    1340540          !o_s_trmb1%flag,o_s_trmb1%name, "deep_cape(HBTM2)", "J/m2")
    1341           !CALL histdef2d(iff,clef_stations(iff), &
     541          !CALL histdef2d(iff, &
    1342542          !o_s_trmb2%flag,o_s_trmb2%name, "inhibition (HBTM2)", "J/m2")
    1343           !CALL histdef2d(iff,clef_stations(iff), &
     543          !CALL histdef2d(iff, &
    1344544          !o_s_trmb3%flag,o_s_trmb3%name, "Point Omega (HBTM2)", "m")
    1345545
    1346546          ! Champs interpolles sur des niveaux de pression
    1347547
    1348           type_ecri(1) = 'inst(X)'
    1349           type_ecri(2) = 'inst(X)'
    1350           type_ecri(3) = 'inst(X)'
    1351           type_ecri(4) = 'inst(X)'
    1352           type_ecri(5) = 'inst(X)'
    1353           type_ecri(6) = 'inst(X)'
    1354 
    1355548          ! Attention a reverifier
    1356549
    1357           ilev=0       
    1358           DO k=1, nlevSTD
    1359              bb2=clevSTD(k)
    1360              IF(bb2.EQ."850".OR.bb2.EQ."700".OR.bb2.EQ."500".OR.bb2.EQ."200" &
     550    ilev=0       
     551    DO k=1, nlevSTD
     552      bb2=clevSTD(k)
     553      IF(bb2.EQ."850".OR.bb2.EQ."700".OR.bb2.EQ."500".OR.bb2.EQ."200" &
    1361554                  .OR.bb2.EQ."100".OR.bb2.EQ."50".OR.bb2.EQ."10")THEN
    1362                 ilev=ilev+1
    1363                 !     print*,'ilev k bb2 flag name ',ilev,k, bb2,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name
    1364                 CALL histdef2d(iff,clef_stations(iff), &
    1365                      o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name,"Zonal wind "//bb2//"hPa", "m/s")
    1366                 CALL histdef2d(iff,clef_stations(iff), &
    1367                      o_vSTDlevs(ilev)%flag,o_vSTDlevs(ilev)%name,"Meridional wind "//bb2//"hPa", "m/s")
    1368                 CALL histdef2d(iff,clef_stations(iff), &
    1369                      o_wSTDlevs(ilev)%flag,o_wSTDlevs(ilev)%name,"Vertical wind "//bb2//"hPa", "Pa/s")
    1370                 CALL histdef2d(iff,clef_stations(iff), &
    1371                      o_zSTDlevs(ilev)%flag,o_zSTDlevs(ilev)%name,"Geopotential height "//bb2//"hPa", "m")
    1372                 CALL histdef2d(iff,clef_stations(iff), &
    1373                      o_qSTDlevs(ilev)%flag,o_qSTDlevs(ilev)%name,"Specific humidity "//bb2//"hPa", "kg/kg" )
    1374                 CALL histdef2d(iff,clef_stations(iff), &
    1375                      o_tSTDlevs(ilev)%flag,o_tSTDlevs(ilev)%name,"Temperature "//bb2//"hPa", "K")
    1376              ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR."500".OR.bb2.EQ."200".OR.bb2.EQ."50".OR.bb2.EQ."10")
    1377           ENDDO
    1378           type_ecri(:) = type_ecri_files(:)
    1379 
    1380           CALL histdef2d(iff,clef_stations(iff), &
    1381                o_t_oce_sic%flag,o_t_oce_sic%name, "Temp mixte oce-sic", "K")
    1382 
    1383           IF (type_ocean=='slab') &
    1384                CALL histdef2d(iff,clef_stations(iff), &
    1385                o_slab_bils%flag, o_slab_bils%name,"Bilan au sol sur ocean slab", "W/m2")
    1386 
    1387           ! Couplage conv-CL
    1388           IF (iflag_con.GE.3) THEN
    1389              IF (iflag_coupl>=1) THEN
    1390                 CALL histdef2d(iff,clef_stations(iff), &
    1391                      o_ale_bl%flag,o_ale_bl%name, "ALE BL", "m2/s2")
    1392                 CALL histdef2d(iff,clef_stations(iff), &
    1393                      o_alp_bl%flag,o_alp_bl%name, "ALP BL", "m2/s2")
    1394              ENDIF
    1395           ENDIF !(iflag_con.GE.3)
    1396 
    1397           CALL histdef2d(iff,clef_stations(iff), &
    1398                o_weakinv%flag,o_weakinv%name, "Weak inversion", "-")
    1399           CALL histdef2d(iff,clef_stations(iff), &
    1400                o_dthmin%flag,o_dthmin%name, "dTheta mini", "K/m")
    1401           CALL histdef2d(iff,clef_stations(iff), &
    1402                o_rh2m%flag,o_rh2m%name, "Relative humidity at 2m", "%" )
    1403 
    1404           IF (.NOT.clef_stations(iff)) THEN
    1405              !
    1406              !IM: there is no way to have one single value in a netcdf file
    1407              !
    1408              type_ecri(1) = 't_min(X)'
    1409              type_ecri(2) = 't_min(X)'
    1410              type_ecri(3) = 't_min(X)'
    1411              type_ecri(4) = 't_min(X)'
    1412              type_ecri(5) = 't_min(X)'
    1413              type_ecri(6) = 't_min(X)'
    1414              CALL histdef2d(iff,clef_stations(iff),o_rh2m_min%flag,o_rh2m_min%name, "Min Relative humidity at 2m", "%" )
    1415              type_ecri(1) = 't_max(X)'
    1416              type_ecri(2) = 't_max(X)'
    1417              type_ecri(3) = 't_max(X)'
    1418              type_ecri(4) = 't_max(X)'
    1419              type_ecri(5) = 't_max(X)'
    1420              type_ecri(6) = 't_max(X)'
    1421              CALL histdef2d(iff,clef_stations(iff),o_rh2m_max%flag,o_rh2m_max%name, "Max Relative humidity at 2m", "%" )
    1422           ENDIF
    1423 
    1424           type_ecri(:) = type_ecri_files(:)
    1425           CALL histdef2d(iff,clef_stations(iff),o_qsat2m%flag,o_qsat2m%name, "Saturant humidity at 2m", "%")
    1426           CALL histdef2d(iff,clef_stations(iff),o_tpot%flag,o_tpot%name, "Surface air potential temperature", "K")
    1427           CALL histdef2d(iff,clef_stations(iff), &
    1428                o_tpote%flag,o_tpote%name, "Surface air equivalent potential temperature", "K")
    1429           CALL histdef2d(iff,clef_stations(iff),o_SWnetOR%flag,o_SWnetOR%name, "Sfce net SW radiation OR", "W/m2")
    1430           CALL histdef2d(iff,clef_stations(iff),o_SWdownOR%flag,o_SWdownOR%name, "Sfce incident SW radiation OR", "W/m2")
    1431           CALL histdef2d(iff,clef_stations(iff),o_LWdownOR%flag,o_LWdownOR%name, "Sfce incident LW radiation OR", "W/m2")
    1432           CALL histdef2d(iff,clef_stations(iff),o_snowl%flag,o_snowl%name, "Solid Large-scale Precip.", "kg/(m2*s)")
    1433 
    1434           CALL histdef2d(iff,clef_stations(iff),o_solldown%flag,o_solldown%name, "Down. IR rad. at surface", "W/m2")
    1435           CALL histdef2d(iff,clef_stations(iff),o_dtsvdfo%flag,o_dtsvdfo%name, "Boundary-layer dTs(o)", "K/s")
    1436           CALL histdef2d(iff,clef_stations(iff),o_dtsvdft%flag,o_dtsvdft%name, "Boundary-layer dTs(t)", "K/s")
    1437           CALL histdef2d(iff,clef_stations(iff),o_dtsvdfg%flag,o_dtsvdfg%name, "Boundary-layer dTs(g)", "K/s")
    1438           CALL histdef2d(iff,clef_stations(iff),o_dtsvdfi%flag,o_dtsvdfi%name, "Boundary-layer dTs(g)", "K/s")
    1439           CALL histdef2d(iff,clef_stations(iff),o_rugs%flag,o_rugs%name, "rugosity", "-" )
     555            ilev=ilev+1
     556            !     print*,'ilev k bb2 flag name ',ilev,k, bb2,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name
     557            CALL histdef2d(iff,o_uSTDlevs(ilev))
     558            CALL histdef2d(iff,o_vSTDlevs(ilev))
     559            CALL histdef2d(iff,o_wSTDlevs(ilev))
     560            CALL histdef2d(iff,o_zSTDlevs(ilev))
     561            CALL histdef2d(iff,o_qSTDlevs(ilev))
     562            CALL histdef2d(iff,o_tSTDlevs(ilev))
     563      ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR."500".OR.bb2.EQ."200".OR.bb2.EQ."50".OR.bb2.EQ."10")
     564    ENDDO
     565
     566    CALL histdef2d(iff,o_t_oce_sic)
     567
     568    IF (type_ocean=='slab') THEN
     569      CALL histdef2d(iff,o_slab_bils)
     570    ENDIF
     571
     572    ! Couplage conv-CL
     573    IF (iflag_con.GE.3) THEN
     574      IF (iflag_coupl>=1) THEN
     575            CALL histdef2d(iff,o_ale_bl)
     576            CALL histdef2d(iff,o_alp_bl)
     577      ENDIF
     578    ENDIF !(iflag_con.GE.3)
     579
     580    CALL histdef2d(iff,o_weakinv)
     581    CALL histdef2d(iff,o_dthmin)
     582
     583    CALL histdef2d(iff,o_rh2m)
     584    CALL histdef2d(iff,o_rh2m_min)
     585    CALL histdef2d(iff,o_rh2m_max)
     586
     587    CALL histdef2d(iff,o_qsat2m)
     588    CALL histdef2d(iff,o_tpot)
     589    CALL histdef2d(iff,o_tpote)
     590    CALL histdef2d(iff,o_SWnetOR)
     591    CALL histdef2d(iff,o_SWdownOR)
     592    CALL histdef2d(iff,o_LWdownOR)
     593    CALL histdef2d(iff,o_snowl)
     594    CALL histdef2d(iff,o_solldown)
     595    CALL histdef2d(iff,o_dtsvdfo)
     596    CALL histdef2d(iff,o_dtsvdft)
     597    CALL histdef2d(iff,o_dtsvdfg)
     598    CALL histdef2d(iff,o_dtsvdfi)
     599    CALL histdef2d(iff,o_rugs)
    1440600
    1441601          ! Champs 3D:
    1442           CALL histdef3d(iff,clef_stations(iff),o_ec550aer%flag,o_ec550aer%name, "Extinction at 550nm", "m^-1")
    1443           CALL histdef3d(iff,clef_stations(iff),o_lwcon%flag,o_lwcon%name, "Cloud liquid water content", "kg/kg")
    1444           CALL histdef3d(iff,clef_stations(iff),o_iwcon%flag,o_iwcon%name, "Cloud ice water content", "kg/kg")
    1445           CALL histdef3d(iff,clef_stations(iff),o_temp%flag,o_temp%name, "Air temperature", "K" )
    1446           CALL histdef3d(iff,clef_stations(iff),o_theta%flag,o_theta%name, "Potential air temperature", "K" )
    1447           CALL histdef3d(iff,clef_stations(iff),o_ovap%flag,o_ovap%name, "Specific humidity", "kg/kg" )
    1448           CALL histdef3d(iff,clef_stations(iff),o_oliq%flag,o_oliq%name, "Condensed water", "kg/kg" )
    1449           CALL histdef3d(iff,clef_stations(iff), &
    1450                o_ovapinit%flag,o_ovapinit%name, "Specific humidity (begin of timestep)", "kg/kg" )
    1451           CALL histdef3d(iff,clef_stations(iff), &
    1452                o_geop%flag,o_geop%name, "Geopotential height", "m2/s2")
    1453           CALL histdef3d(iff,clef_stations(iff), &
    1454                o_vitu%flag,o_vitu%name, "Zonal wind", "m/s" )
    1455           CALL histdef3d(iff,clef_stations(iff), &
    1456                o_vitv%flag,o_vitv%name, "Meridional wind", "m/s" )
    1457           CALL histdef3d(iff,clef_stations(iff), &
    1458                o_vitw%flag,o_vitw%name, "Vertical wind", "Pa/s" )
    1459           CALL histdef3d(iff,clef_stations(iff), &
    1460                o_pres%flag,o_pres%name, "Air pressure", "Pa" )
    1461           CALL histdef3d(iff,clef_stations(iff), &
    1462                o_paprs%flag,o_paprs%name, "Air pressure Inter-Couches", "Pa" )
    1463           CALL histdef3d(iff,clef_stations(iff), &
    1464                o_mass%flag,o_mass%name, "Masse Couches", "kg/m2" )
    1465           CALL histdef3d(iff,clef_stations(iff), &
    1466                o_zfull%flag,o_zfull%name, "Altitude of full pressure levels", "m" )
    1467           CALL histdef3d(iff,clef_stations(iff), &
    1468                o_zhalf%flag,o_zhalf%name, "Altitude of half pressure levels", "m" )
    1469           CALL histdef3d(iff,clef_stations(iff), &
    1470                o_rneb%flag,o_rneb%name, "Cloud fraction", "-")
    1471           CALL histdef3d(iff,clef_stations(iff), &
    1472                o_rnebcon%flag,o_rnebcon%name, "Convective Cloud Fraction", "-")
    1473           CALL histdef3d(iff,clef_stations(iff), &
    1474                o_rnebls%flag,o_rnebls%name, "LS Cloud fraction", "-")
    1475           CALL histdef3d(iff,clef_stations(iff), &
    1476                o_rhum%flag,o_rhum%name, "Relative humidity", "-")
    1477           CALL histdef3d(iff,clef_stations(iff), &
    1478                o_ozone%flag,o_ozone%name, "Ozone mole fraction", "-")
    1479           if (read_climoz == 2) &
    1480                CALL histdef3d(iff,clef_stations(iff), &
    1481                o_ozone_light%flag,o_ozone_light%name, &
    1482                "Daylight ozone mole fraction", "-")
    1483           CALL histdef3d(iff,clef_stations(iff), &
    1484                o_dtphy%flag,o_dtphy%name, "Physics dT", "K/s")
    1485           CALL histdef3d(iff,clef_stations(iff), &
    1486                o_dqphy%flag,o_dqphy%name, "Physics dQ", "(kg/kg)/s")
    1487           CALL histdef3d(iff,clef_stations(iff), &
    1488                o_cldtau%flag,o_cldtau%name, "Cloud optical thickness", "1")
    1489           CALL histdef3d(iff,clef_stations(iff), &
    1490                o_cldemi%flag,o_cldemi%name, "Cloud optical emissivity", "1")
    1491           !IM: bug ?? dimensionnement variables (klon,klev+1) pmflxr, pmflxs, prfl, psfl
    1492           CALL histdef3d(iff,clef_stations(iff), &
    1493                o_pr_con_l%flag,o_pr_con_l%name, "Convective precipitation lic", " ")
    1494           CALL histdef3d(iff,clef_stations(iff), &
    1495                o_pr_con_i%flag,o_pr_con_i%name, "Convective precipitation ice", " ")
    1496           CALL histdef3d(iff,clef_stations(iff), &
    1497                o_pr_lsc_l%flag,o_pr_lsc_l%name, "Large scale precipitation lic", " ")
    1498           CALL histdef3d(iff,clef_stations(iff), &
    1499                o_pr_lsc_i%flag,o_pr_lsc_i%name, "Large scale precipitation ice", " ")
    1500           !Cloud droplet effective radius
    1501           CALL histdef3d(iff,clef_stations(iff), &
    1502                o_re%flag,o_re%name, "Cloud droplet effective radius","um")
    1503           CALL histdef3d(iff,clef_stations(iff), &
    1504                o_fl%flag,o_fl%name, "Denominator of Cloud droplet effective radius"," ")
    1505           !FH Sorties pour la couche limite
    1506           if (iflag_pbl>1) then
    1507              CALL histdef3d(iff,clef_stations(iff), &
    1508                   o_tke%flag,o_tke%name, "TKE", "m2/s2")
    1509              IF (.NOT.clef_stations(iff)) THEN
    1510                 !
    1511                 !IM: there is no way to have one single value in a netcdf file
    1512                 !
    1513                 type_ecri(1) = 't_max(X)'
    1514                 type_ecri(2) = 't_max(X)'
    1515                 type_ecri(3) = 't_max(X)'
    1516                 type_ecri(4) = 't_max(X)'
    1517                 type_ecri(5) = 't_max(X)'
    1518                 type_ecri(6) = 't_max(X)'
    1519                 CALL histdef3d(iff,clef_stations(iff), &
    1520                      o_tke_max%flag,o_tke_max%name, "TKE max", "m2/s2")
    1521              ENDIF
    1522              type_ecri(:) = type_ecri_files(:)
    1523           endif
    1524 
    1525           CALL histdef3d(iff,clef_stations(iff), &
    1526                o_kz%flag,o_kz%name, "Kz melange", "m2/s")
    1527           IF (.NOT.clef_stations(iff)) THEN
    1528              !
    1529              !IM: there is no way to have one single value in a netcdf file
    1530              !
    1531              type_ecri(1) = 't_max(X)'
    1532              type_ecri(2) = 't_max(X)'
    1533              type_ecri(3) = 't_max(X)'
    1534              type_ecri(4) = 't_max(X)'
    1535              type_ecri(5) = 't_max(X)'
    1536              type_ecri(6) = 't_max(X)'
    1537              CALL histdef3d(iff,clef_stations(iff), &
    1538                   o_kz_max%flag,o_kz_max%name, "Kz melange max", "m2/s" )
    1539           ENDIF
    1540           type_ecri(:) = type_ecri_files(:)
    1541           CALL histdef3d(iff,clef_stations(iff), &
    1542                o_clwcon%flag,o_clwcon%name, "Convective Cloud Liquid water content", "kg/kg")
    1543           CALL histdef3d(iff,clef_stations(iff), &
    1544                o_dtdyn%flag,o_dtdyn%name, "Dynamics dT", "K/s")
    1545           CALL histdef3d(iff,clef_stations(iff), &
    1546                o_dqdyn%flag,o_dqdyn%name, "Dynamics dQ", "(kg/kg)/s")
    1547           CALL histdef3d(iff,clef_stations(iff), &
    1548                o_dudyn%flag,o_dudyn%name, "Dynamics dU", "m/s2")
    1549           CALL histdef3d(iff,clef_stations(iff), &
    1550                o_dvdyn%flag,o_dvdyn%name, "Dynamics dV", "m/s2")
    1551           CALL histdef3d(iff,clef_stations(iff), &
    1552                o_dtcon%flag,o_dtcon%name, "Convection dT", "K/s")
    1553           CALL histdef3d(iff,clef_stations(iff), &
    1554                o_ducon%flag,o_ducon%name, "Convection du", "m/s2")
    1555           CALL histdef3d(iff,clef_stations(iff), &
    1556                o_dvcon%flag,o_dvcon%name, "Convection dv", "m/s2")
    1557           CALL histdef3d(iff,clef_stations(iff), &
    1558                o_dqcon%flag,o_dqcon%name, "Convection dQ", "(kg/kg)/s")
    1559 
    1560           ! Wakes
    1561           IF(iflag_con.EQ.3) THEN
    1562              IF (iflag_wake >= 1) THEN
    1563                 CALL histdef2d(iff,clef_stations(iff), &
    1564                      o_ale_wk%flag,o_ale_wk%name, "ALE WK", "m2/s2")
    1565                 CALL histdef2d(iff,clef_stations(iff), &
    1566                      o_alp_wk%flag,o_alp_wk%name, "ALP WK", "m2/s2")
    1567                 CALL histdef2d(iff,clef_stations(iff), &
    1568                      o_ale%flag,o_ale%name, "ALE", "m2/s2")
    1569                 CALL histdef2d(iff,clef_stations(iff), &
    1570                      o_alp%flag,o_alp%name, "ALP", "W/m2")
    1571                 CALL histdef2d(iff,clef_stations(iff),o_cin%flag,o_cin%name, "Convective INhibition", "m2/s2")
    1572                 CALL histdef2d(iff,clef_stations(iff),o_wape%flag,o_WAPE%name, "WAPE", "m2/s2")
    1573                 CALL histdef2d(iff,clef_stations(iff),o_wake_h%flag,o_wake_h%name, "wake_h", "-")
    1574                 CALL histdef2d(iff,clef_stations(iff),o_wake_s%flag,o_wake_s%name, "wake_s", "-")
    1575                 CALL histdef3d(iff,clef_stations(iff),o_dtwak%flag,o_dtwak%name, "Wake dT", "K/s")
    1576                 CALL histdef3d(iff,clef_stations(iff),o_dqwak%flag,o_dqwak%name, "Wake dQ", "(kg/kg)/s")
    1577                 CALL histdef3d(iff,clef_stations(iff),o_wake_deltat%flag,o_wake_deltat%name, "wake_deltat", " ")
    1578                 CALL histdef3d(iff,clef_stations(iff),o_wake_deltaq%flag,o_wake_deltaq%name, "wake_deltaq", " ")
    1579                 CALL histdef3d(iff,clef_stations(iff),o_wake_omg%flag,o_wake_omg%name, "wake_omg", " ")
    1580              ENDIF
    1581 !!! RomP             CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")
    1582              CALL histdef3d(iff,clef_stations(iff),o_ftd%flag,o_ftd%name, "tend temp due aux descentes precip", "-")
    1583              CALL histdef3d(iff,clef_stations(iff),o_fqd%flag,o_fqd%name,"tend vap eau due aux descentes precip", "-")
    1584           ENDIF !(iflag_con.EQ.3)
    1585 
    1586           IF(iflag_con.GE.3) THEN   !  RomP >>>
    1587             CALL histdef3d(iff,clef_stations(iff),o_wdtrainA%flag,o_wdtrainA%name, "precipitation from AA", "-")
    1588             CALL histdef3d(iff,clef_stations(iff),o_wdtrainM%flag,o_wdtrainM%name, "precipitation from mixture", "-")
    1589             CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")
    1590           ENDIF !(iflag_con.GE.3)   ! <<< RomP
     602    CALL histdef3d(iff,o_ec550aer)
     603    CALL histdef3d(iff,o_lwcon)
     604    CALL histdef3d(iff,o_iwcon)
     605    CALL histdef3d(iff,o_temp)
     606    CALL histdef3d(iff,o_theta)
     607    CALL histdef3d(iff,o_ovap)
     608    CALL histdef3d(iff,o_oliq)
     609    CALL histdef3d(iff,o_ovapinit)
     610    CALL histdef3d(iff,o_geop)
     611    CALL histdef3d(iff,o_vitu)
     612    CALL histdef3d(iff,o_vitv)
     613    CALL histdef3d(iff,o_vitw)
     614    CALL histdef3d(iff,o_pres)
     615    CALL histdef3d(iff,o_paprs)
     616    CALL histdef3d(iff,o_mass)
     617    CALL histdef3d(iff,o_zfull)
     618    CALL histdef3d(iff,o_zhalf)
     619    CALL histdef3d(iff,o_rneb)
     620    CALL histdef3d(iff,o_rnebcon)
     621    CALL histdef3d(iff,o_rnebls)
     622    CALL histdef3d(iff,o_rhum)
     623    CALL histdef3d(iff,o_ozone)
     624
     625    IF (read_climoz == 2) THEN
     626      CALL histdef3d(iff,o_ozone_light)
     627    END IF
     628
     629    CALL histdef3d(iff,o_dtphy)
     630    CALL histdef3d(iff,o_dqphy)
     631    CALL histdef3d(iff,o_cldtau)
     632    CALL histdef3d(iff,o_cldemi)
     633!IM: bug ?? dimensionnement variables (klon,klev+1) pmflxr, pmflxs, prfl, psfl
     634    CALL histdef3d(iff,o_pr_con_l)
     635    CALL histdef3d(iff,o_pr_con_i)
     636    CALL histdef3d(iff,o_pr_lsc_l)
     637    CALL histdef3d(iff,o_pr_lsc_i)
     638!Cloud droplet effective radius
     639    CALL histdef3d(iff,o_re)
     640    CALL histdef3d(iff,o_fl)
     641!FH Sorties pour la couche limite
     642    IF (iflag_pbl>1) THEN
     643      CALL histdef3d(iff,o_tke)
     644      CALL histdef3d(iff,o_tke_max)
     645    ENDIF
     646    CALL histdef3d(iff,o_kz)
     647    CALL histdef3d(iff,o_kz_max)
     648    CALL histdef3d(iff,o_clwcon)
     649    CALL histdef3d(iff,o_dtdyn)
     650    CALL histdef3d(iff,o_dqdyn)
     651    CALL histdef3d(iff,o_dudyn)
     652    CALL histdef3d(iff,o_dvdyn)
     653    CALL histdef3d(iff,o_dtcon)
     654    CALL histdef3d(iff,o_ducon)
     655    CALL histdef3d(iff,o_dvcon)
     656    CALL histdef3d(iff,o_dqcon)
     657
     658! Wakes
     659    IF(iflag_con.EQ.3) THEN
     660      IF (iflag_wake >= 1) THEN
     661            CALL histdef2d(iff,o_ale_wk)
     662            CALL histdef2d(iff,o_alp_wk)
     663            CALL histdef2d(iff,o_ale)
     664            CALL histdef2d(iff,o_alp)
     665            CALL histdef2d(iff,o_cin)
     666            CALL histdef2d(iff,o_wape)
     667            CALL histdef2d(iff,o_wake_h)
     668            CALL histdef2d(iff,o_wake_s)
     669            CALL histdef3d(iff,o_dtwak)
     670            CALL histdef3d(iff,o_dqwak)
     671            CALL histdef3d(iff,o_wake_deltat)
     672            CALL histdef3d(iff,o_wake_deltaq)
     673            CALL histdef3d(iff,o_wake_omg)
     674      ENDIF
     675!!! RomP             CALL histdef3d(iff,o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")
     676      CALL histdef3d(iff,o_ftd)
     677      CALL histdef3d(iff,o_fqd)
     678    ENDIF !(iflag_con.EQ.3)
     679
     680    IF(iflag_con.GE.3) THEN   !  RomP >>>
     681      CALL histdef3d(iff,o_wdtrainA)
     682      CALL histdef3d(iff,o_wdtrainM)
     683      CALL histdef3d(iff,o_Vprecip)
     684    ENDIF !(iflag_con.GE.3)   ! <<< RomP
    1591685
    1592686!!! nrlmd le 10/04/2012
    1593687
    1594         IF (iflag_trig_bl>=1) THEN
    1595  CALL histdef2d(iff,clef_stations(iff),o_n2%flag,o_n2%name, "Nombre de panaches de type 2", " ")
    1596  CALL histdef2d(iff,clef_stations(iff),o_s2%flag,o_s2%name, "Surface moyenne des panaches de type 2", "m2")
    1597 
    1598  CALL histdef2d(iff,clef_stations(iff),o_proba_notrig%flag,o_proba_notrig%name, "Probabilité de non-déclenchement", " ")
    1599  CALL histdef2d(iff,clef_stations(iff),o_random_notrig%flag,o_random_notrig%name, "Tirage aléatoire de non-déclenchement", " ")
    1600  CALL histdef2d(iff,clef_stations(iff),o_ale_bl_trig%flag,o_ale_bl_trig%name, "ALE_BL_STAT + Condition P>Pseuil", "m2/s2")
    1601  CALL histdef2d(iff,clef_stations(iff),o_ale_bl_stat%flag,o_ale_bl_stat%name, "ALE_BL_STAT", "m2/s2")
    1602        ENDIF  !(iflag_trig_bl>=1)
    1603 
    1604         IF (iflag_clos_bl>=1) THEN
    1605  CALL histdef2d(iff,clef_stations(iff),o_alp_bl_det%flag,o_alp_bl_det%name, "ALP_BL_DET", "W/m2")
    1606  CALL histdef2d(iff,clef_stations(iff),o_alp_bl_fluct_m%flag,o_alp_bl_fluct_m%name, "ALP_BL_FLUCT_M", "W/m2")
    1607  CALL histdef2d(iff,clef_stations(iff),o_alp_bl_fluct_tke%flag,o_alp_bl_fluct_tke%name, "ALP_BL_FLUCT_TKE", "W/m2")
    1608  CALL histdef2d(iff,clef_stations(iff),o_alp_bl_conv%flag,o_alp_bl_conv%name, "ALP_BL_CONV", "W/m2")
    1609  CALL histdef2d(iff,clef_stations(iff),o_alp_bl_stat%flag,o_alp_bl_stat%name, "ALP_BL_STAT", "W/m2")
    1610        ENDIF  !(iflag_clos_bl>=1)
     688    IF (iflag_trig_bl>=1) THEN
     689      CALL histdef2d(iff,o_n2)
     690      CALL histdef2d(iff,o_s2)
     691      CALL histdef2d(iff,o_proba_notrig)
     692      CALL histdef2d(iff,o_random_notrig)
     693      CALL histdef2d(iff,o_ale_bl_trig)
     694      CALL histdef2d(iff,o_ale_bl_stat)
     695    ENDIF  !(iflag_trig_bl>=1)
     696
     697    IF (iflag_clos_bl>=1) THEN
     698      CALL histdef2d(iff,o_alp_bl_det)
     699      CALL histdef2d(iff,o_alp_bl_fluct_m)
     700      CALL histdef2d(iff,o_alp_bl_fluct_tke)
     701      CALL histdef2d(iff,o_alp_bl_conv)
     702      CALL histdef2d(iff,o_alp_bl_stat)
     703    ENDIF  !(iflag_clos_bl>=1)
    1611704
    1612705!!! fin nrlmd le 10/04/2012
    1613 
    1614           CALL histdef3d(iff,clef_stations(iff),o_dtlsc%flag,o_dtlsc%name, "Condensation dT", "K/s")
    1615           CALL histdef3d(iff,clef_stations(iff),o_dtlschr%flag,o_dtlschr%name,"Large-scale condensational heating rate","K/s")
    1616           CALL histdef3d(iff,clef_stations(iff),o_dqlsc%flag,o_dqlsc%name, "Condensation dQ", "(kg/kg)/s")
    1617           CALL histdef3d(iff,clef_stations(iff),o_beta_prec%flag,o_beta_prec%name, "LS Conversion rate to prec", "(kg/kg)/s")
    1618           CALL histdef3d(iff,clef_stations(iff),o_dtvdf%flag,o_dtvdf%name, "Boundary-layer dT", "K/s")
    1619           CALL histdef3d(iff,clef_stations(iff),o_dqvdf%flag,o_dqvdf%name, "Boundary-layer dQ", "(kg/kg)/s")
    1620           CALL histdef3d(iff,clef_stations(iff),o_dteva%flag,o_dteva%name, "Reevaporation dT", "K/s")
    1621           CALL histdef3d(iff,clef_stations(iff),o_dqeva%flag,o_dqeva%name, "Reevaporation dQ", "(kg/kg)/s")
    1622           CALL histdef3d(iff,clef_stations(iff),o_ptconv%flag,o_ptconv%name, "POINTS CONVECTIFS", " ")
    1623           CALL histdef3d(iff,clef_stations(iff),o_ratqs%flag,o_ratqs%name, "RATQS", " ")
    1624           CALL histdef3d(iff,clef_stations(iff),o_dtthe%flag,o_dtthe%name, "Thermal dT", "K/s")
    1625 
    1626           if(iflag_thermals.ge.1) THEN
    1627              CALL histdef3d(iff,clef_stations(iff),o_dqlscth%flag,o_dqlscth%name, "dQ therm.", "(kg/kg)/s")
    1628              CALL histdef3d(iff,clef_stations(iff),o_dqlscst%flag,o_dqlscst%name, "dQ strat.", "(kg/kg)/s")
    1629              CALL histdef3d(iff,clef_stations(iff),o_dtlscth%flag,o_dtlscth%name, "dQ therm.", "K/s")
    1630              CALL histdef3d(iff,clef_stations(iff),o_dtlscst%flag,o_dtlscst%name, "dQ strat.", "K/s")
    1631              CALL histdef2d(iff,clef_stations(iff),o_plulth%flag,o_plulth%name, "Rainfall therm.", "K/s")
    1632              CALL histdef2d(iff,clef_stations(iff),o_plulst%flag,o_plulst%name, "Rainfall strat.", "K/s")
    1633              CALL histdef2d(iff,clef_stations(iff),o_lmaxth%flag,o_lmaxth%name, "Upper level thermals", "")
    1634              CALL histdef3d(iff,clef_stations(iff),o_ptconvth%flag,o_ptconvth%name, "POINTS CONVECTIFS therm.", " ")
    1635              CALL histdef3d(iff,clef_stations(iff),o_f_th%flag,o_f_th%name, "Thermal plume mass flux", "kg/(m2*s)")
    1636              CALL histdef3d(iff,clef_stations(iff),o_e_th%flag,o_e_th%name,"Thermal plume entrainment","K/s")
    1637              CALL histdef3d(iff,clef_stations(iff),o_w_th%flag,o_w_th%name,"Thermal plume vertical velocity","m/s")
    1638              CALL histdef2d(iff,clef_stations(iff), &
    1639                   o_ftime_th%flag,o_ftime_th%name,"Fraction of time Shallow convection occurs"," ")
    1640              CALL histdef3d(iff,clef_stations(iff), &
    1641                   o_q_th%flag,o_q_th%name, "Thermal plume total humidity", "kg/kg")
    1642              CALL histdef3d(iff,clef_stations(iff), &
    1643                   o_a_th%flag,o_a_th%name, "Thermal plume fraction", "")
    1644              CALL histdef3d(iff,clef_stations(iff), &
    1645                   o_d_th%flag,o_d_th%name, "Thermal plume detrainment", "K/s")
    1646 
    1647              CALL histdef2d(iff,clef_stations(iff), &
    1648                   o_f0_th%flag,o_f0_th%name, "Thermal closure mass flux", "K/s")
    1649              CALL histdef2d(iff,clef_stations(iff), &
    1650                   o_zmax_th%flag,o_zmax_th%name, "Thermal plume height", "K/s")
    1651              CALL histdef3d(iff,clef_stations(iff), &
    1652                   o_dqthe%flag,o_dqthe%name, "Thermal dQ", "(kg/kg)/s")
    1653           endif !iflag_thermals.ge.1
    1654           CALL histdef3d(iff,clef_stations(iff), &
    1655                o_dtajs%flag,o_dtajs%name, "Dry adjust. dT", "K/s")
    1656           CALL histdef3d(iff,clef_stations(iff), &
    1657                o_dqajs%flag,o_dqajs%name, "Dry adjust. dQ", "(kg/kg)/s")
    1658           CALL histdef3d(iff,clef_stations(iff), &
    1659                o_dtswr%flag,o_dtswr%name, "SW radiation dT", "K/s")
    1660           CALL histdef3d(iff,clef_stations(iff), &
    1661                o_dtsw0%flag,o_dtsw0%name, "CS SW radiation dT", "K/s")
    1662           CALL histdef3d(iff,clef_stations(iff), &
    1663                o_dtlwr%flag,o_dtlwr%name, "LW radiation dT", "K/s")
    1664           CALL histdef3d(iff,clef_stations(iff), &
    1665                o_dtlw0%flag,o_dtlw0%name, "CS LW radiation dT", "K/s")
    1666           CALL histdef3d(iff,clef_stations(iff), &
    1667                o_dtec%flag,o_dtec%name, "Cinetic dissip dT", "K/s")
    1668           CALL histdef3d(iff,clef_stations(iff), &
    1669                o_duvdf%flag,o_duvdf%name, "Boundary-layer dU", "m/s2")
    1670           CALL histdef3d(iff,clef_stations(iff), &
    1671                o_dvvdf%flag,o_dvvdf%name, "Boundary-layer dV", "m/s2")
    1672 
    1673           IF (ok_orodr) THEN
    1674              CALL histdef3d(iff,clef_stations(iff), &
    1675                   o_duoro%flag,o_duoro%name, "Orography dU", "m/s2")
    1676              CALL histdef3d(iff,clef_stations(iff), &
    1677                   o_dvoro%flag,o_dvoro%name, "Orography dV", "m/s2")
    1678              CALL histdef3d(iff,clef_stations(iff), &
    1679                   o_dtoro%flag,o_dtoro%name, "Orography dT", "K/s")
    1680           ENDIF
    1681 
    1682           IF (ok_orolf) THEN
    1683              CALL histdef3d(iff,clef_stations(iff), &
    1684                   o_dulif%flag,o_dulif%name, "Orography dU", "m/s2")
    1685              CALL histdef3d(iff,clef_stations(iff), &
    1686                   o_dvlif%flag,o_dvlif%name, "Orography dV", "m/s2")
    1687              CALL histdef3d(iff,clef_stations(iff), &
    1688                   o_dtlif%flag,o_dtlif%name, "Orography dT", "K/s")
    1689           ENDIF
    1690 
    1691           IF (ok_hines) then
    1692              CALL histdef3d(iff,clef_stations(iff), &
    1693                   o_duhin%flag,o_duhin%name, "Hines GWD dU", "m/s2")
    1694              CALL histdef3d(iff,clef_stations(iff), &
    1695                   o_dvhin%flag,o_dvhin%name, "Hines GWD dV", "m/s2")
    1696 
    1697              CALL histdef3d(iff,clef_stations(iff), &
    1698                   o_dthin%flag,o_dthin%name, "Hines GWD dT", "K/s")
    1699           ENDIF
    1700 
    1701           CALL histdef3d(iff,clef_stations(iff), &
    1702                o_rsu%flag,o_rsu%name, "SW upward radiation", "W m-2")
    1703           CALL histdef3d(iff,clef_stations(iff), &
    1704                o_rsd%flag,o_rsd%name, "SW downward radiation", "W m-2")
    1705           CALL histdef3d(iff,clef_stations(iff), &
    1706                o_rlu%flag,o_rlu%name, "LW upward radiation", "W m-2")
    1707           CALL histdef3d(iff,clef_stations(iff), &
    1708                o_rld%flag,o_rld%name, "LW downward radiation", "W m-2")
    1709 
    1710           CALL histdef3d(iff,clef_stations(iff), &
    1711                o_rsucs%flag,o_rsucs%name, "SW CS upward radiation", "W m-2")
    1712           CALL histdef3d(iff,clef_stations(iff), &
    1713                o_rsdcs%flag,o_rsdcs%name, "SW CS downward radiation", "W m-2")
    1714           CALL histdef3d(iff,clef_stations(iff), &
    1715                o_rlucs%flag,o_rlucs%name, "LW CS upward radiation", "W m-2")
    1716           CALL histdef3d(iff,clef_stations(iff), &
    1717                o_rldcs%flag,o_rldcs%name, "LW CS downward radiation", "W m-2")
    1718 
    1719           CALL histdef3d(iff,clef_stations(iff), &
    1720                o_tnt%flag,o_tnt%name, "Tendency of air temperature", "K s-1")
    1721 
    1722           CALL histdef3d(iff,clef_stations(iff), &
    1723                o_tntc%flag,o_tntc%name, "Tendency of air temperature due to Moist Convection", &
    1724                "K s-1")
    1725 
    1726           CALL histdef3d(iff,clef_stations(iff), &
    1727                o_tntr%flag,o_tntr%name, "Air temperature tendency due to Radiative heating", &
    1728                "K s-1")
    1729 
    1730           CALL histdef3d(iff,clef_stations(iff), &
    1731                o_tntscpbl%flag,o_tntscpbl%name, "Air temperature tendency due to St cloud and precipitation and BL mixing", &
    1732                "K s-1")
    1733 
    1734           CALL histdef3d(iff,clef_stations(iff), &
    1735                o_tnhus%flag,o_tnhus%name, "Tendency of specific humidity", "s-1")
    1736 
    1737           CALL histdef3d(iff,clef_stations(iff), &
    1738                o_tnhusc%flag,o_tnhusc%name, "Tendency of specific humidity due to convection", "s-1")
    1739 
    1740           CALL histdef3d(iff,clef_stations(iff), &
    1741                o_tnhusscpbl%flag,o_tnhusscpbl%name, "Tendency of Specific humidity due to ST cl, precip and BL mixing", &
    1742                "s-1")
    1743 
    1744           CALL histdef3d(iff,clef_stations(iff), &
    1745                o_evu%flag,o_evu%name, "Eddy viscosity coefficient for Momentum Variables", "m2 s-1")
    1746 
    1747           CALL histdef3d(iff,clef_stations(iff), &
    1748                o_h2o%flag,o_h2o%name, "Mass Fraction of Water", "1")
    1749 
    1750           CALL histdef3d(iff,clef_stations(iff), &
    1751                o_mcd%flag,o_mcd%name, "Downdraft COnvective Mass Flux", "kg/(m2*s)")
    1752 
    1753           CALL histdef3d(iff,clef_stations(iff), &
    1754                o_dmc%flag,o_dmc%name, "Deep COnvective Mass Flux", "kg/(m2*s)")
    1755 
    1756           CALL histdef3d(iff,clef_stations(iff), &
    1757                o_ref_liq%flag,o_ref_liq%name, "Effective radius of convective cloud liquid water particle", "m")
    1758 
    1759           CALL histdef3d(iff,clef_stations(iff), &
    1760                o_ref_ice%flag,o_ref_ice%name, "Effective radius of startiform cloud ice particle", "m")
    1761 
    1762           if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
     706    CALL histdef3d(iff,o_dtlsc)
     707    CALL histdef3d(iff,o_dtlschr)
     708    CALL histdef3d(iff,o_dqlsc)
     709    CALL histdef3d(iff,o_beta_prec)
     710    CALL histdef3d(iff,o_dtvdf)
     711    CALL histdef3d(iff,o_dtdis)
     712    CALL histdef3d(iff,o_dqvdf)
     713    CALL histdef3d(iff,o_dteva)
     714    CALL histdef3d(iff,o_dqeva)
     715    CALL histdef3d(iff,o_ptconv)
     716    CALL histdef3d(iff,o_ratqs)
     717    CALL histdef3d(iff,o_dtthe)
     718
     719    IF (iflag_thermals.ge.1) THEN
     720      CALL histdef3d(iff,o_dqlscth)
     721      CALL histdef3d(iff,o_dqlscst)
     722      CALL histdef3d(iff,o_dtlscth)
     723      CALL histdef3d(iff,o_dtlscst)
     724      CALL histdef2d(iff,o_plulth)
     725      CALL histdef2d(iff,o_plulst)
     726      CALL histdef2d(iff,o_lmaxth)
     727      CALL histdef3d(iff,o_ptconvth)
     728      CALL histdef3d(iff,o_f_th)
     729      CALL histdef3d(iff,o_e_th)
     730      CALL histdef3d(iff,o_w_th)
     731      CALL histdef3d(iff,o_lambda_th)
     732      CALL histdef2d(iff,o_ftime_th)
     733      CALL histdef3d(iff,o_q_th)
     734      CALL histdef3d(iff,o_a_th)
     735      CALL histdef3d(iff,o_d_th)
     736      CALL histdef2d(iff,o_f0_th)
     737      CALL histdef2d(iff,o_zmax_th)
     738      CALL histdef3d(iff,o_dqthe)
     739    ENDIF !iflag_thermals.ge.1
     740
     741    CALL histdef3d(iff,o_dtajs)
     742    CALL histdef3d(iff,o_dqajs)
     743    CALL histdef3d(iff,o_dtswr)
     744    CALL histdef3d(iff,o_dtsw0)
     745    CALL histdef3d(iff,o_dtlwr)
     746    CALL histdef3d(iff,o_dtlw0)
     747    CALL histdef3d(iff,o_dtec)
     748    CALL histdef3d(iff,o_duvdf)
     749    CALL histdef3d(iff,o_dvvdf)
     750
     751    IF (ok_orodr) THEN
     752      CALL histdef3d(iff,o_duoro)
     753      CALL histdef3d(iff,o_dvoro)
     754      CALL histdef3d(iff,o_dtoro)
     755    ENDIF
     756
     757    IF (ok_orolf) THEN
     758      CALL histdef3d(iff,o_dulif)
     759      CALL histdef3d(iff,o_dvlif)
     760      CALL histdef3d(iff,o_dtlif)
     761    ENDIF
     762
     763    IF (ok_hines) then
     764      CALL histdef3d(iff,o_duhin)
     765      CALL histdef3d(iff,o_dvhin)
     766      CALL histdef3d(iff,o_dthin)
     767    ENDIF
     768
     769    CALL histdef3d(iff,o_rsu)
     770    CALL histdef3d(iff,o_rsd)
     771    CALL histdef3d(iff,o_rlu)
     772    CALL histdef3d(iff,o_rld)
     773    CALL histdef3d(iff,o_rsucs)
     774    CALL histdef3d(iff,o_rsdcs)
     775    CALL histdef3d(iff,o_rlucs)
     776    CALL histdef3d(iff,o_rldcs)
     777    CALL histdef3d(iff,o_tnt)
     778    CALL histdef3d(iff,o_tntc)
     779    CALL histdef3d(iff,o_tntr)
     780    CALL histdef3d(iff,o_tntscpbl)
     781    CALL histdef3d(iff,o_tnhus)
     782    CALL histdef3d(iff,o_tnhusc)
     783    CALL histdef3d(iff,o_tnhusscpbl)
     784    CALL histdef3d(iff,o_evu)
     785    CALL histdef3d(iff,o_h2o)
     786    CALL histdef3d(iff,o_mcd)
     787    CALL histdef3d(iff,o_dmc)
     788    CALL histdef3d(iff,o_ref_liq)
     789    CALL histdef3d(iff,o_ref_ice)
     790
     791    IF (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
    1763792               RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
    1764793               RCFC12_per.NE.RCFC12_act) THEN
    1765 
    1766              CALL histdef2d(iff,clef_stations(iff),o_rsut4co2%flag,o_rsut4co2%name, &
    1767                   "TOA Out SW in 4xCO2 atmosphere", "W/m2")
    1768              CALL histdef2d(iff,clef_stations(iff),o_rlut4co2%flag,o_rlut4co2%name, &
    1769                   "TOA Out LW in 4xCO2 atmosphere", "W/m2")
    1770              CALL histdef2d(iff,clef_stations(iff),o_rsutcs4co2%flag,o_rsutcs4co2%name, &
    1771                   "TOA Out CS SW in 4xCO2 atmosphere", "W/m2")
    1772              CALL histdef2d(iff,clef_stations(iff),o_rlutcs4co2%flag,o_rlutcs4co2%name, &
    1773                   "TOA Out CS LW in 4xCO2 atmosphere", "W/m2")
    1774 
    1775              CALL histdef3d(iff,clef_stations(iff),o_rsu4co2%flag,o_rsu4co2%name, &
    1776                   "Upwelling SW 4xCO2 atmosphere", "W/m2")
    1777              CALL histdef3d(iff,clef_stations(iff),o_rlu4co2%flag,o_rlu4co2%name, &
    1778                   "Upwelling LW 4xCO2 atmosphere", "W/m2")
    1779              CALL histdef3d(iff,clef_stations(iff),o_rsucs4co2%flag,o_rsucs4co2%name, &
    1780                   "Upwelling CS SW 4xCO2 atmosphere", "W/m2")
    1781              CALL histdef3d(iff,clef_stations(iff),o_rlucs4co2%flag,o_rlucs4co2%name, &
    1782                   "Upwelling CS LW 4xCO2 atmosphere", "W/m2")
    1783 
    1784              CALL histdef3d(iff,clef_stations(iff),o_rsd4co2%flag,o_rsd4co2%name, &
    1785                   "Downwelling SW 4xCO2 atmosphere", "W/m2")
    1786              CALL histdef3d(iff,clef_stations(iff),o_rld4co2%flag,o_rld4co2%name, &
    1787                   "Downwelling LW 4xCO2 atmosphere", "W/m2")
    1788              CALL histdef3d(iff,clef_stations(iff),o_rsdcs4co2%flag,o_rsdcs4co2%name, &
    1789                   "Downwelling CS SW 4xCO2 atmosphere", "W/m2")
    1790              CALL histdef3d(iff,clef_stations(iff),o_rldcs4co2%flag,o_rldcs4co2%name, &
    1791                   "Downwelling CS LW 4xCO2 atmosphere", "W/m2")
    1792 
    1793           endif
    1794 
    1795 
    1796           IF (nqtot>=3) THEN
    1797              DO iq=3,nqtot 
    1798                 iiq=niadv(iq)
    1799                 o_trac(iq-2) = ctrl_out((/ 4, 5, 1, 1, 1, 10 /),tname(iiq))
    1800                 CALL histdef3d (iff,clef_stations(iff), &
    1801                 o_trac(iq-2)%flag,o_trac(iq-2)%name,'Tracer '//ttext(iiq), "-" )
    1802                 o_trac_cum(iq-2) = ctrl_out((/ 3, 4, 10, 10, 10, 10 /),'cum'//tname(iiq))
    1803                 CALL histdef2d (iff,clef_stations(iff), &
    1804                 o_trac_cum(iq-2)%flag,o_trac_cum(iq-2)%name,'Cumulated tracer '//ttext(iiq), "-" )
    1805              ENDDO
    1806           ENDIF
    1807 
    1808           CALL histend(nid_files(iff))
    1809 
    1810           ndex2d = 0
    1811           ndex3d = 0
    1812 
    1813        ENDIF ! clef_files
     794      CALL histdef2d(iff,o_rsut4co2)
     795      CALL histdef2d(iff,o_rlut4co2)
     796      CALL histdef2d(iff,o_rsutcs4co2)
     797      CALL histdef2d(iff,o_rlutcs4co2)
     798      CALL histdef3d(iff,o_rsu4co2)
     799      CALL histdef3d(iff,o_rlu4co2)
     800      CALL histdef3d(iff,o_rsucs4co2)
     801      CALL histdef3d(iff,o_rlucs4co2)
     802      CALL histdef3d(iff,o_rsd4co2)
     803      CALL histdef3d(iff,o_rld4co2)
     804      CALL histdef3d(iff,o_rsdcs4co2)
     805      CALL histdef3d(iff,o_rldcs4co2)
     806
     807    ENDIF
     808
     809
     810      IF (nqtot>=3) THEN
     811            DO iq=3,nqtot 
     812            iiq=niadv(iq)
     813            o_trac(iq-2) = ctrl_out((/ 4, 5, 1, 1, 1, 10 /),tname(iiq),'Tracer '//ttext(iiq), "-",&
     814                  (/ '', '', '', '', '', '' /))
     815            CALL histdef3d(iff, o_trac(iq-2))
     816            o_trac_cum(iq-2) = ctrl_out((/ 3, 4, 10, 10, 10, 10 /),'cum'//tname(iiq),&
     817                  'Cumulated tracer '//ttext(iiq), "-", (/ '', '', '', '', '', '' /))
     818            CALL histdef2d(iff, o_trac_cum(iq-2))
     819            ENDDO
     820      ENDIF
     821
     822      CALL histend(nid_files(iff))
     823
     824      ndex2d = 0
     825      ndex3d = 0
     826
     827    ENDIF ! clef_files
    1814828
    1815829    ENDDO !  iff
    … …  
    1824838    ecrit_ins = ecrit_files(6)
    1825839
    1826     write(lunout,*)'swaero_diag=',swaero_diag
    1827     write(lunout,*)'Fin phys_output_mod.F90'
    1828   end subroutine phys_output_open
    1829 
    1830   SUBROUTINE histdef2d (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
    1831 
    1832     use ioipsl
     840    WRITE(lunout,*)'swaero_diag=',swaero_diag
     841    WRITE(lunout,*)'Fin phys_output_mod.F90'
     842  end SUBROUTINE phys_output_open
     843
     844  SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
     845
     846    USE ioipsl
    1833847    USE dimphy
    1834848    USE mod_phys_lmdz_para
    … …  
    1837851    IMPLICIT NONE
    1838852
    1839     include "dimensions.h"
    1840     include "temps.h"
    1841     include "indicesol.h"
    1842     include "clesphys.h"
    1843 
    1844     integer                          :: iff
    1845     logical                          :: lpoint
    1846     integer, dimension(nfiles)       :: flag_var
    1847     character(len=20)                 :: nomvar
    1848     character(len=*)                 :: titrevar
    1849     character(len=*)                 :: unitvar
    1850 
    1851     real zstophym
    1852 
    1853     if (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') then
     853    INCLUDE "dimensions.h"
     854    INCLUDE "temps.h"
     855    INCLUDE "clesphys.h"
     856
     857    INTEGER                          :: iff
     858    LOGICAL                          :: lpoint
     859    INTEGER, DIMENSION(nfiles)       :: flag_var
     860    CHARACTER(LEN=20)                 :: nomvar
     861    CHARACTER(LEN=*)                 :: titrevar
     862    CHARACTER(LEN=*)                 :: unitvar
     863
     864    REAL zstophym
     865
     866    IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
    1854867       zstophym=zoutm(iff)
    1855     else
     868    ELSE
    1856869       zstophym=zdtime
    1857     endif
     870    ENDIF
    1858871
    1859872    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    1860     call conf_physoutputs(nomvar,flag_var)
    1861 
    1862     if(.NOT.lpoint) THEN 
    1863        if ( flag_var(iff)<=lev_files(iff) ) then
    1864           call histdef (nid_files(iff),nomvar,titrevar,unitvar, &
     873    CALL conf_physoutputs(nomvar,flag_var)
     874
     875    IF(.NOT.lpoint) THEN 
     876       IF ( flag_var(iff)<=lev_files(iff) ) THEN
     877          CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
    1865878               iim,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
    1866879               type_ecri(iff), zstophym,zoutm(iff))               
    1867        endif
    1868     else
    1869        if ( flag_var(iff)<=lev_files(iff) ) then
    1870           call histdef (nid_files(iff),nomvar,titrevar,unitvar, &
     880       ENDIF
     881    ELSE
     882       IF ( flag_var(iff)<=lev_files(iff) ) THEN
     883          CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
    1871884               npstn,1,nhorim(iff), 1,1,1, -99, 32, &
    1872885               type_ecri(iff), zstophym,zoutm(iff))               
    1873        endif
    1874     endif
     886       ENDIF
     887    ENDIF
    1875888
    1876889    ! Set swaero_diag=true if at least one of the concerned variables are defined
    1877     if (nomvar=='topswad' .OR. nomvar=='topswai' .OR. nomvar=='solswad' .OR. nomvar=='solswai' ) THEN
    1878        if  ( flag_var(iff)<=lev_files(iff) ) then
     890    IF (nomvar=='topswad' .OR. nomvar=='topswai' .OR. nomvar=='solswad' .OR. nomvar=='solswai' ) THEN
     891       IF  ( flag_var(iff)<=lev_files(iff) ) THEN
    1879892          swaero_diag=.TRUE.
    1880        end if
    1881     end if
    1882   end subroutine histdef2d
    1883 
    1884   SUBROUTINE histdef3d (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
    1885 
    1886     use ioipsl
     893       END IF
     894    END IF
     895  END SUBROUTINE histdef2d_old
     896
     897  SUBROUTINE histdef2d (iff,var)
     898
     899    USE ioipsl
    1887900    USE dimphy
    1888901    USE mod_phys_lmdz_para
    … …  
    1891904    IMPLICIT NONE
    1892905
    1893     include "dimensions.h"
    1894     include "temps.h"
    1895     include "indicesol.h"
    1896     include "clesphys.h"
    1897 
    1898     integer                          :: iff
    1899     logical                          :: lpoint
    1900     integer, dimension(nfiles)       :: flag_var
    1901     character(len=20)                 :: nomvar
    1902     character(len=*)                 :: titrevar
    1903     character(len=*)                 :: unitvar
    1904 
    1905     real zstophym
     906    INCLUDE "dimensions.h"
     907    INCLUDE "temps.h"
     908    INCLUDE "clesphys.h"
     909
     910    INTEGER                          :: iff
     911    TYPE(ctrl_out)                   :: var
     912
     913    REAL zstophym
     914    CHARACTER(LEN=20) :: typeecrit
     915
     916    ! ug On récupère le type écrit de la structure:
     917    !       Assez moche, à refaire si meilleure méthode...
     918    IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
     919       typeecrit = 'once'
     920    ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
     921       typeecrit = 't_min(X)'
     922    ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
     923       typeecrit = 't_max(X)'
     924    ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
     925       typeecrit = 'inst(X)'
     926    ELSE
     927       typeecrit = type_ecri_files(iff)
     928    ENDIF
     929
     930    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
     931       zstophym=zoutm(iff)
     932    ELSE
     933       zstophym=zdtime
     934    ENDIF
    1906935
    1907936    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    1908     call conf_physoutputs(nomvar,flag_var)
    1909 
    1910     if (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') then
     937    CALL conf_physoutputs(var%name, var%flag)
     938
     939    IF(.NOT.clef_stations(iff)) THEN 
     940       IF ( var%flag(iff)<=lev_files(iff) ) THEN
     941          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
     942               iim,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
     943               typeecrit, zstophym,zoutm(iff))               
     944       ENDIF
     945    ELSE
     946       IF ( var%flag(iff)<=lev_files(iff)) THEN
     947          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
     948               npstn,1,nhorim(iff), 1,1,1, -99, 32, &
     949               typeecrit, zstophym,zoutm(iff))               
     950       ENDIF
     951    ENDIF
     952
     953    ! Set swaero_diag=true if at least one of the concerned variables are defined
     954    IF (var%name=='topswad' .OR. var%name=='topswai' .OR. var%name=='solswad' .OR. var%name=='solswai' ) THEN
     955       IF  ( var%flag(iff)<=lev_files(iff) ) THEN
     956          swaero_diag=.TRUE.
     957       END IF
     958    END IF
     959  END SUBROUTINE histdef2d
     960
     961  SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
     962
     963    USE ioipsl
     964    USE dimphy
     965    USE mod_phys_lmdz_para
     966    USE iophy
     967
     968    IMPLICIT NONE
     969
     970    INCLUDE "dimensions.h"
     971    INCLUDE "temps.h"
     972!    INCLUDE "indicesol.h"
     973    INCLUDE "clesphys.h"
     974
     975    INTEGER                          :: iff
     976    LOGICAL                          :: lpoint
     977    INTEGER, DIMENSION(nfiles)       :: flag_var
     978    CHARACTER(LEN=20)                 :: nomvar
     979    CHARACTER(LEN=*)                 :: titrevar
     980    CHARACTER(LEN=*)                 :: unitvar
     981
     982    REAL zstophym
     983
     984    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
     985    CALL conf_physoutputs(nomvar,flag_var)
     986
     987    IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
    1911988       zstophym=zoutm(iff)
    1912     else
     989    ELSE
    1913990       zstophym=zdtime
    1914     endif
    1915 
    1916     if(.NOT.lpoint) THEN
    1917        if ( flag_var(iff)<=lev_files(iff) ) then
    1918           call histdef (nid_files(iff), nomvar, titrevar, unitvar, &
     991    ENDIF
     992
     993    IF(.NOT.lpoint) THEN
     994       IF ( flag_var(iff)<=lev_files(iff) ) THEN
     995          CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
    1919996               iim, jj_nb, nhorim(iff), klev, levmin(iff), &
    1920997               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
    1921998               zstophym, zoutm(iff))
    1922        endif
    1923     else
    1924        if ( flag_var(iff)<=lev_files(iff) ) then
    1925           call histdef (nid_files(iff), nomvar, titrevar, unitvar, &
     999       ENDIF
     1000    ELSE
     1001       IF ( flag_var(iff)<=lev_files(iff) ) THEN
     1002          CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
    19261003               npstn,1,nhorim(iff), klev, levmin(iff), &
    19271004               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
    19281005               type_ecri(iff), zstophym,zoutm(iff))
    1929        endif
    1930     endif
    1931   end subroutine histdef3d
     1006       ENDIF
     1007    ENDIF
     1008  END SUBROUTINE histdef3d_old
     1009
     1010  SUBROUTINE histdef3d (iff,var)
     1011
     1012    USE ioipsl
     1013    USE dimphy
     1014    USE mod_phys_lmdz_para
     1015    USE iophy
     1016
     1017    IMPLICIT NONE
     1018
     1019    INCLUDE "dimensions.h"
     1020    INCLUDE "temps.h"
     1021    INCLUDE "clesphys.h"
     1022
     1023    INTEGER                          :: iff
     1024    TYPE(ctrl_out)                   :: var
     1025
     1026    REAL zstophym
     1027    CHARACTER(LEN=20) :: typeecrit
     1028
     1029    ! ug On récupère le type écrit de la structure:
     1030    !       Assez moche, à refaire si meilleure méthode...
     1031    IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
     1032       typeecrit = 'once'
     1033    ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
     1034       typeecrit = 't_min(X)'
     1035    ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
     1036       typeecrit = 't_max(X)'
     1037    ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
     1038       typeecrit = 'inst(X)'
     1039    ELSE
     1040       typeecrit = type_ecri_files(iff)
     1041    ENDIF
     1042
     1043
     1044    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
     1045    CALL conf_physoutputs(var%name,var%flag)
     1046
     1047    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
     1048       zstophym=zoutm(iff)
     1049    ELSE
     1050       zstophym=zdtime
     1051    ENDIF
     1052
     1053    IF(.NOT.clef_stations(iff)) THEN
     1054       IF ( var%flag(iff)<=lev_files(iff) ) THEN
     1055          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
     1056               iim, jj_nb, nhorim(iff), klev, levmin(iff), &
     1057               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, &
     1058               zstophym, zoutm(iff))
     1059       ENDIF
     1060    ELSE
     1061       IF ( var%flag(iff)<=lev_files(iff)) THEN
     1062          CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
     1063               npstn,1,nhorim(iff), klev, levmin(iff), &
     1064               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
     1065               typeecrit, zstophym,zoutm(iff))
     1066       ENDIF
     1067    ENDIF
     1068  END SUBROUTINE histdef3d
    19321069
    19331070  SUBROUTINE conf_physoutputs(nam_var,flag_var)
    … …  
    19401077    include 'iniprint.h'
    19411078
    1942     character(len=20)                :: nam_var
    1943     integer, dimension(nfiles)      :: flag_var
     1079    CHARACTER(LEN=20)                :: nam_var
     1080    INTEGER, DIMENSION(nfiles)      :: flag_var
    19441081
    19451082    IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
    1946     call getin('flag_'//nam_var,flag_var)
    1947     call getin('name_'//nam_var,nam_var)
     1083    CALL getin('flag_'//nam_var,flag_var)
     1084    CALL getin('name_'//nam_var,nam_var)
    19481085    IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
    19491086
    … …  
    19571094    IMPLICIT NONE
    19581095
    1959     character(len=20)   :: str
    1960     character(len=10)   :: type
    1961     integer             :: ipos,il
     1096    CHARACTER(LEN=20)   :: str
     1097    CHARACTER(LEN=10)   :: type
     1098    INTEGER             :: ipos,il
    19621099    real                :: ttt,xxx,timestep,dayseconde,dtime
    19631100    parameter (dayseconde=86400.)
    … …  
    19661103    include "iniprint.h"
    19671104
    1968     ipos=scan(str,'0123456789.',.true.)
     1105    ipos=scan(str,'0123456789.',.TRUE.)
    19691106    ! 
    19701107    il=len_trim(str)
    1971     write(lunout,*)ipos,il
     1108    WRITE(lunout,*)ipos,il
    19721109    read(str(1:ipos),*) ttt
    1973     write(lunout,*)ttt
     1110    WRITE(lunout,*)ttt
    19741111    type=str(ipos+1:il)
    19751112
    19761113
    1977     if ( il == ipos ) then
     1114    IF ( il == ipos ) then
    19781115       type='day'
    19791116    endif
    19801117
    1981     if ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
    1982     if ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
    1983        write(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
     1118    IF ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
     1119    IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
     1120       WRITE(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
    19841121       timestep = ttt * dayseconde * mth_len
    19851122    endif
    1986     if ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
    1987     if ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
    1988     if ( type == 's'.or.type == 'sec'.or.type == 'secondes'   ) timestep = ttt
    1989     if ( type == 'TS' ) timestep = ttt * dtime
    1990 
    1991     write(lunout,*)'type =      ',type
    1992     write(lunout,*)'nb j/h/m =  ',ttt
    1993     write(lunout,*)'timestep(s)=',timestep
     1123    IF ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
     1124    IF ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
     1125    IF ( type == 's'.or.type == 'sec'.or.type == 'secondes'   ) timestep = ttt
     1126    IF ( type == 'TS' ) timestep = ttt * dtime
     1127
     1128    WRITE(lunout,*)'type =      ',type
     1129    WRITE(lunout,*)'nb j/h/m =  ',ttt
     1130    WRITE(lunout,*)'timestep(s)=',timestep
    19941131
    19951132  END SUBROUTINE convers_timesteps

  • LMDZ5/branches/testing/libf/phylmd/phys_output_var_mod.F90

    r1335 r1795  
    1414      REAL, SAVE, ALLOCATABLE :: snow_o(:), zfra_o(:)
    1515!$OMP THREADPRIVATE(snow_o, zfra_o)
    16       INTEGER, save, ALLOCATABLE ::  itau_con(:)       ! Nombre de pas ou rflag <= 1
     16      INTEGER, SAVE, ALLOCATABLE ::  itau_con(:)       ! Nombre de pas ou rflag <= 1
    1717!$OMP THREADPRIVATE(itau_con)
     18      REAL, ALLOCATABLE :: bils_ec(:) ! Contribution of energy conservation
     19      REAL, ALLOCATABLE :: bils_tke(:) ! Contribution of energy conservation
     20      REAL, ALLOCATABLE :: bils_diss(:) ! Contribution of energy conservation
     21      REAL, ALLOCATABLE :: bils_kinetic(:) ! bilan de chaleur au sol, kinetic
     22      REAL, ALLOCATABLE :: bils_enthalp(:) ! bilan de chaleur au sol
     23      REAL, ALLOCATABLE :: bils_latent(:) ! bilan de chaleur au sol
     24!$OMP THREADPRIVATE(bils_ec,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
    1825
     26! ug Plein de variables venues de phys_output_mod
     27      INTEGER, PARAMETER                           :: nfiles = 6
     28      LOGICAL, DIMENSION(nfiles), SAVE             :: clef_files
     29      LOGICAL, DIMENSION(nfiles), SAVE             :: clef_stations
     30      INTEGER, DIMENSION(nfiles), SAVE             :: lev_files
     31      INTEGER, DIMENSION(nfiles), SAVE             :: nid_files
     32      INTEGER, DIMENSION(nfiles), SAVE  :: nnid_files
     33!$OMP THREADPRIVATE(clef_files, clef_stations, lev_files,nid_files,nnid_files)
     34      INTEGER, DIMENSION(nfiles), SAVE :: nnhorim
     35
     36      INTEGER, DIMENSION(nfiles), SAVE :: nhorim, nvertm
     37      INTEGER, DIMENSION(nfiles), SAVE :: nvertap, nvertbp, nvertAlt
     38      REAL, DIMENSION(nfiles), SAVE                :: zoutm
     39      CHARACTER(LEN=20), DIMENSION(nfiles), SAVE   :: type_ecri
     40!$OMP THREADPRIVATE(nnhorim, nhorim, nvertm, zoutm,type_ecri)
     41      CHARACTER(LEN=20), DIMENSION(nfiles), SAVE  :: type_ecri_files, phys_out_filetypes
     42!$OMP THREADPRIVATE(type_ecri_files, phys_out_filetypes)
     43
     44 ! swaero_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
     45      LOGICAL, SAVE                                :: swaero_diag=.FALSE.
     46!$OMP THREADPRIVATE(swaero_diag)
     47
     48      INTEGER, SAVE:: levmin(nfiles) = 1
     49      INTEGER, SAVE:: levmax(nfiles)
     50!$OMP THREADPRIVATE(levmin, levmax)
     51
     52  TYPE ctrl_out
     53     INTEGER,DIMENSION(nfiles)            :: flag
     54     CHARACTER(len=20)                    :: name
     55     CHARACTER(len=150)                   :: description
     56     CHARACTER(len=20)                    :: unit
     57     CHARACTER(len=20),DIMENSION(nfiles)  :: type_ecrit
     58  END TYPE ctrl_out
    1959CONTAINS
    2060
    … …  
    2767      allocate(snow_o(klon), zfra_o(klon))
    2868      allocate(itau_con(klon))
     69      allocate (bils_ec(klon),bils_tke(klon),bils_diss(klon),bils_kinetic(klon),bils_enthalp(klon),bils_latent(klon))
    2970
    3071END SUBROUTINE phys_output_var_init
    … …  
    3677
    3778      deallocate(snow_o,zfra_o,itau_con)
     79      deallocate (bils_ec,bils_tke,bils_diss,bils_kinetic,bils_enthalp,bils_latent)
    3880
    3981END SUBROUTINE phys_output_var_end

  • LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90

    r1750 r1795  
    6363!$OMP THREADPRIVATE(ratqs)
    6464      REAL, ALLOCATABLE, SAVE :: pbl_tke(:,:,:) ! turb kinetic energy
    65 !$OMP THREADPRIVATE(pbl_tke)
     65      REAL, ALLOCATABLE, SAVE :: coefh(:,:,:) ! Kz enthalpie
     66      REAL, ALLOCATABLE, SAVE :: coefm(:,:,:) ! Kz momentum
     67!$OMP THREADPRIVATE(pbl_tke, coefh,coefm)
    6668      REAL, ALLOCATABLE, SAVE :: zmax0(:), f0(:) !
    6769!$OMP THREADPRIVATE(zmax0,f0)
    … …  
    359361!======================================================================
    360362SUBROUTINE phys_state_var_init(read_climoz)
    361 use dimphy
     363USE dimphy
    362364USE control_mod
    363 use aero_mod
    364 use infotrac, ONLY : nbtr
     365USE aero_mod
     366USE infotrac, ONLY : nbtr
     367USE indice_sol_mod
    365368IMPLICIT NONE
    366369
    … …  
    373376! climatology and the daylight climatology
    374377
    375 #include "indicesol.h"
    376378      ALLOCATE(rlat(klon), rlon(klon))
    377379      ALLOCATE(pctsrf(klon,nbsrf))
    … …  
    394396      ALLOCATE(clwcon(klon,klev),rnebcon(klon,klev))
    395397      ALLOCATE(ratqs(klon,klev))
    396       ALLOCATE(pbl_tke(klon,klev+1,nbsrf))
     398      ALLOCATE(pbl_tke(klon,klev+1,nbsrf+1))
     399      ALLOCATE(coefh(klon,klev+1,nbsrf+1))
     400      ALLOCATE(coefm(klon,klev+1,nbsrf+1))
    397401      ALLOCATE(zmax0(klon), f0(klon))
    398402      ALLOCATE(ema_work1(klon,klev), ema_work2(klon,klev))
    … …  
    518522!======================================================================
    519523SUBROUTINE phys_state_var_end
    520 use dimphy
    521 use control_mod
     524USE dimphy
     525USE control_mod
     526USE indice_sol_mod
    522527IMPLICIT NONE
    523 #include "indicesol.h"
    524528
    525529      deallocate(rlat, rlon, pctsrf, ftsol, falb1, falb2)
    … …  
    530534      deallocate(        u_ancien, v_ancien                 )
    531535      deallocate(        tr_ancien)                           !RomP
    532       deallocate(ratqs, pbl_tke)
     536      deallocate(ratqs, pbl_tke,coefh,coefm)
    533537      deallocate(zmax0, f0)
    534538      deallocate(ema_work1, ema_work2)

  • LMDZ5/branches/testing/libf/phylmd/physiq.F

    r1750 r1795  
    3131      USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
    3232      USE phys_output_mod
     33      USE phys_output_ctrlout_mod
     34      USE iophy
    3335      use open_climoz_m, only: open_climoz ! ozone climatology from a file
    3436      use regr_pr_av_m, only: regr_pr_av
    3537      use netcdf95, only: nf95_close
    3638cIM for NMC files
    37       use netcdf, only: nf90_fill_real
     39c     use netcdf, only: nf90_fill_real
     40      use netcdf
    3841      use mod_phys_lmdz_mpi_data, only: is_mpi_root
    3942      USE aero_mod
    … …  
    4548      USE CHEM_REP, ONLY : Init_chem_rep_xjour
    4649#endif
    47 
     50      USE indice_sol_mod
    4851
    4952!IM stations CFMIP
    5053      USE CFMIP_point_locations
    5154      IMPLICIT none
    52 c======================================================================
    53 c
    54 c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    55 c
    56 c Objet: Moniteur general de la physique du modele
    57 cAA      Modifications quant aux traceurs :
    58 cAA                  -  uniformisation des parametrisations ds phytrac
    59 cAA                  -  stockage des moyennes des champs necessaires
    60 cAA                     en mode traceur off-line
    61 c======================================================================
    62 c   CLEFS CPP POUR LES IO
    63 c   =====================
     55!>======================================================================
     56!!
     57!! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
     58!!
     59!! Objet: Moniteur general de la physique du modele
     60!!AA      Modifications quant aux traceurs :
     61!!AA                  -  uniformisation des parametrisations ds phytrac
     62!!AA                  -  stockage des moyennes des champs necessaires
     63!!AA                     en mode traceur off-line
     64!!======================================================================
     65!!   CLEFS CPP POUR LES IO
     66!!   =====================
    6467#define histNMC
    6568c#define histISCCP
    66 c======================================================================
    67 c    modif   ( P. Le Van ,  12/10/98 )
    68 c
    69 c  Arguments:
    70 c
    71 c nlon----input-I-nombre de points horizontaux
    72 c nlev----input-I-nombre de couches verticales, doit etre egale a klev
    73 c debut---input-L-variable logique indiquant le premier passage
    74 c lafin---input-L-variable logique indiquant le dernier passage
    75 c jD_cur       -R-jour courant a l'appel de la physique (jour julien)
    76 c jH_cur       -R-heure courante a l'appel de la physique (jour julien)
    77 c pdtphys-input-R-pas d'integration pour la physique (seconde)
    78 c paprs---input-R-pression pour chaque inter-couche (en Pa)
    79 c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
    80 c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
    81 c pphis---input-R-geopotentiel du sol
    82 c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
    83 c u-------input-R-vitesse dans la direction X (de O a E) en m/s
    84 c v-------input-R-vitesse Y (de S a N) en m/s
    85 c t-------input-R-temperature (K)
    86 c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
    87 c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
    88 c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
    89 c flxmass_w -input-R- flux de masse verticale
    90 c d_u-----output-R-tendance physique de "u" (m/s/s)
    91 c d_v-----output-R-tendance physique de "v" (m/s/s)
    92 c d_t-----output-R-tendance physique de "t" (K/s)
    93 c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
    94 c d_ps----output-R-tendance physique de la pression au sol
    95 cIM
    96 c PVteta--output-R-vorticite potentielle a des thetas constantes
    97 c======================================================================
     69!!======================================================================
     70!!    modif   ( P. Le Van ,  12/10/98 )
     71!!
     72!!  Arguments:
     73!!
     74!! nlon----input-I-nombre de points horizontaux
     75!! nlev----input-I-nombre de couches verticales, doit etre egale a klev
     76!! debut---input-L-variable logique indiquant le premier passage
     77!! lafin---input-L-variable logique indiquant le dernier passage
     78!! jD_cur       -R-jour courant a l'appel de la physique (jour julien)
     79!! jH_cur       -R-heure courante a l'appel de la physique (jour julien)
     80!! pdtphys-input-R-pas d'integration pour la physique (seconde)
     81!! paprs---input-R-pression pour chaque inter-couche (en Pa)
     82!! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
     83!! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
     84!! pphis---input-R-geopotentiel du sol
     85!! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
     86!! u-------input-R-vitesse dans la direction X (de O a E) en m/s
     87!! v-------input-R-vitesse Y (de S a N) en m/s
     88!! t-------input-R-temperature (K)
     89!! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
     90!! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
     91!! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
     92!! flxmass_w -input-R- flux de masse verticale
     93!! d_u-----output-R-tendance physique de "u" (m/s/s)
     94!! d_v-----output-R-tendance physique de "v" (m/s/s)
     95!! d_t-----output-R-tendance physique de "t" (K/s)
     96!! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
     97!! d_ps----output-R-tendance physique de la pression au sol
     98!!IM
     99!! PVteta--output-R-vorticite potentielle a des thetas constantes
     100!!======================================================================
    98101#include "dimensions.h"
    99102      integer jjmp1
    … …  
    103106
    104107#include "regdim.h"
    105 #include "indicesol.h"
    106108#include "dimsoil.h"
    107109#include "clesphys.h"
    … …  
    218220      REAL u(klon,klev)
    219221      REAL v(klon,klev)
    220       REAL t(klon,klev),theta(klon,klev)
     222      REAL t(klon,klev),theta(klon,klev),thetal(klon,klev)
     223c thetal: ligne suivante a decommenter si vous avez les fichiers     MPL 20130625
     224c fth_fonctions.F90 et parkind1.F90
     225c sinon thetal=theta
     226c     REAL fth_thetae,fth_thetav,fth_thetal
    221227      REAL qx(klon,klev,nqtot)
    222228      REAL flxmass_w(klon,klev)
    … …  
    642648      REAL zw2(klon,klev+1)
    643649      REAL fraca(klon,klev+1)       
    644       REAL ztv(klon,klev) 
     650      REAL ztv(klon,klev),ztva(klon,klev)
    645651      REAL zpspsk(klon,klev)
    646       REAL ztla(klon,klev)
     652      REAL ztla(klon,klev),zqla(klon,klev)
    647653      REAL zthl(klon,klev)
    648654
    … …  
    655661      real w0(klon)                                          ! Vitesse des thermiques au LCL
    656662      real w_conv(klon)                                      ! Vitesse verticale de grande \'echelle au LCL
     663      real tke0(klon,klev+1)                                 ! TKE au début du pas de temps
    657664      real therm_tke_max0(klon)                              ! TKE dans les thermiques au LCL
    658665      real env_tke_max0(klon)                                ! TKE dans l'environnement au LCL
    … …  
    694701cAA
    695702cAA  Pour phytrac
    696 cAA
    697       REAL coefh(klon,klev)     ! coef d'echange pour phytrac, valable pour 2<=k<=klev
    698       REAL coefm(klon,klev)     ! coef d'echange pour U, V
    699703      REAL u1(klon)             ! vents dans la premiere couche U
    700704      REAL v1(klon)             ! vents dans la premiere couche V
    … …  
    722726
    723727      REAL bils(klon) ! bilan de chaleur au sol
     728
    724729      REAL wfbilo(klon,nbsrf) ! bilan d'eau, pour chaque
    725730C                             ! type de sous-surface et pondere par la fraction
    … …  
    751756      SAVE lmt_pas                ! frequence de mise a jour
    752757c$OMP THREADPRIVATE(lmt_pas)
    753       real zmasse(klon, llm)
     758      real zmasse(klon, llm),exner(klon, llm)
    754759C     (column-density of mass of air in a cell, in kg m-2)
    755760      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
    … …  
    10581063     .           prof2d_av = 3, prof3d_av = 4)
    10591064      character*30 nom_fichier
    1060       character*10 varname
     1065      character*40 varname
    10611066      character*40 vartitle
    10621067      character*20 varunits
    … …  
    11211126      LOGICAL, SAVE :: new_aod
    11221127c$OMP THREADPRIVATE(new_aod)
    1123    
     1128c
     1129c--STRAT AEROSOL
     1130      LOGICAL, SAVE :: flag_aerosol_strat
     1131c$OMP THREADPRIVATE(flag_aerosol_strat)
     1132cc-fin STRAT AEROSOL
    11241133c
    11251134c Declaration des constantes et des fonctions thermodynamiques
    … …  
    12711280     .     iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,
    12721281     .     ok_ade, ok_aie, ok_cdnc, aerosol_couple,
    1273      .     flag_aerosol, new_aod,
     1282     .     flag_aerosol, flag_aerosol_strat, new_aod,
    12741283     .     bl95_b0, bl95_b1,
    12751284c     nv flags pour la convection et les poches froides
    … …  
    12871296          pbase=0
    12881297cIM 180608
    1289 c         pmflxr=0.
    1290 c         pmflxs=0.
    12911298
    12921299        itau_con=0
    … …  
    13951402
    13961403         CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
     1404         IF (klon_glo==1) THEN
     1405         coefh=0. ; coefm=0. ; pbl_tke=0.
     1406         coefh(:,2,:)=1.e-2 ; coefm(:,2,:)=1.e-2 ; pbl_tke(:,2,:)=1.e-2
     1407         PRINT*,'FH WARNING : lignes a supprimer'
     1408         ENDIF
    13971409cIM begin
    13981410          print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1)
    … …  
    15931605     &                       ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,
    15941606     &                       read_climoz, phys_out_filestations,
    1595      &                       new_aod, aerosol_couple
    1596      &                        )
     1607     &                       new_aod, aerosol_couple,
     1608     &                       flag_aerosol_strat )
    15971609c$OMP END MASTER
    15981610c$OMP BARRIER
    … …  
    17691781      d1a(:,:)=0.
    17701782      dam(:,:)=0.
     1783          pmflxr=0.
     1784          pmflxs=0.
    17711785! RomP <<<
    17721786
    … …  
    17841798      ENDDO
    17851799      ENDDO
     1800      tke0(:,:)=pbl_tke(:,:,is_ave)
    17861801      IF (nqtot.GE.3) THEN
    17871802      DO iq = 3, nqtot
    … …  
    20722087     s     albsol1,   albsol2,   sens,    evap, 
    20732088     s     zxtsol,    zxfluxlat, zt2m,    qsat2m,
    2074      s     d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
     2089     s     d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss,
    20752090     s     coefh,     coefm,     slab_wfbils,               
    20762091     d     qsol,      zq2m,      s_pblh,  s_lcl,
    … …  
    20882103!-----------------------------------------------------------------------------------------
    20892104! ajout des tendances de la diffusion turbulente
    2090       CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf')
     2105      CALL add_phys_tend
     2106     s     (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,'vdf')
    20912107!-----------------------------------------------------------------------------------------
    20922108
    … …  
    26582674     s      ,alp_bl_conv,alp_bl_stat
    26592675ccc fin nrlmd le 10/04/2012
    2660      s                )
     2676     s      ,zqla,ztva )
    26612677
    26622678ccc nrlmd le 10/04/2012
    … …  
    29662982         cg_aero(:,:,:,:)  = 0.
    29672983      ENDIF
     2984c
     2985c--STRAT AEROSOL
     2986c--updates tausum_aero,tau_aero,piz_aero,cg_aero
     2987      IF (flag_aerosol_strat) THEN
     2988         PRINT *,'appel a readaerosolstrat', mth_cur
     2989         CALL readaerosolstrato(debut)
     2990      ENDIF
     2991c--fin STRAT AEROSOL
    29682992
    29692993cIM calcul nuages par le simulateur ISCCP
    … …  
    31743198     $                          paprs,
    31753199     $                          pplay,
    3176      $                          coefh,
     3200     $                          coefh(:,:,is_ave),
    31773201     $                          pphi,
    31783202     $                          t_seri,
    … …  
    33533377     e        t_seri,q_seri,wo,
    33543378     e        cldfrarad, cldemirad, cldtaurad,
    3355      e        ok_ade, ok_aie, flag_aerosol,
     3379     e        ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol,
     3380     e        flag_aerosol_strat,
    33563381     e        tau_aero, piz_aero, cg_aero,
    33573382     e        cldtaupirad,new_aod,
    … …  
    33953420     e        t_seri,q_seri,wo,
    33963421     e        cldfra, cldemi, cldtau,
    3397      e        ok_ade, ok_aie, flag_aerosol,
     3422     e        ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol,
     3423     e        flag_aerosol_strat,
    33983424     e        tau_aero, piz_aero, cg_aero,
    33993425     e        cldtaupi,new_aod,
    … …  
    34313457         solsw=0.
    34323458         radsol=0.
     3459         swup=0.    ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
     3460         swup0=0.
     3461         swdn=0.
     3462         swdn0=0.
     3463         lwup=0.
     3464         lwup0=0.
     3465         lwdn=0.
     3466         lwdn0=0.
    34333467      END IF
    34343468
    … …  
    36953729     I     paprs,    pplay,     pmfu,     pmfd,
    36963730     I     pen_u,    pde_u,     pen_d,    pde_d,
    3697      I     cdragh,   coefh,     fm_therm, entr_therm,
     3731     I     cdragh,   coefh(:,:,is_ave),     fm_therm, entr_therm,
    36983732     I     u1,       v1,        ftsol,    pctsrf,
    36993733     I     ustar,     u10m,      v10m,
    … …  
    37223756     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    37233757     I                   fm_therm,entr_therm,
    3724      I                   cdragh,coefh,u1,v1,ftsol,pctsrf,
     3758     I                   cdragh,coefh(:,:,is_ave),u1,v1,ftsol,pctsrf,
    37253759     I                   frac_impa, frac_nucl,
    37263760     I                   pphis,airephy,dtime,itap,
    … …  
    37483782c Accumuler les variables a stocker dans les fichiers histoire:
    37493783c
    3750 c+jld ec_conser
    3751       DO k = 1, klev
    3752       DO i = 1, klon
    3753         ZRCPD = RCPD*(1.0+RVTMP2*q_seri(i,k))
    3754         d_t_ec(i,k)=0.5/ZRCPD
    3755      $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
    3756       ENDDO
    3757       ENDDO
    3758 
    3759       DO k = 1, klev
    3760       DO i = 1, klon
    3761         t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
    3762         d_t_ec(i,k) = d_t_ec(i,k)/dtime
    3763        END DO
    3764       END DO
    3765 c-jld ec_conser
     3784
     3785!================================================================
     3786! Conversion of kinetic and potential energy into heat, for
     3787! parameterisation of subgrid-scale motions
     3788!================================================================
     3789
     3790      d_t_ec(:,:)=0.
     3791      forall (k=1: llm) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
     3792      CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap),
     3793     s        u_seri,v_seri,t_seri,q_seri,pbl_tke(:,:,is_ave)-tke0(:,:),
     3794     s        zmasse,exner,d_t_ec)
     3795      t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
     3796
    37663797cIM
    37673798      IF (ip_ebil_phy.ge.1) THEN
    … …  
    38333864      END IF
    38343865
    3835 c=============================================================
     3866
    38363867c
    38373868c Convertir les incrementations en tendances
    … …  
    39463977cJYG/IM theta en fin de pas de temps de physique
    39473978        theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
     3979c thetal: 2 lignes suivantes a decommenter si vous avez les fichiers     MPL 20130625
     3980c fth_fonctions.F90 et parkind1.F90
     3981c sinon thetal=theta
     3982c       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
     3983c    :         ql_seri(i,k))
     3984        thetal(i,k)=theta(i,k)
    39483985      ENDDO
    39493986      ENDDO
    … …  
    39623999      CALL fonte_neige_get_vars(pctsrf,
    39634000     .     zxfqcalving, zxfqfonte, zxffonte)
     4001
    39644002
    39654003
    … …  
    39934031      endif
    39944032
    3995  
    3996 #include "phys_output_write.h"
     4033#include "phys_output_write_new.h"
     4034
     4035
     4036
    39974037
    39984038#ifdef histISCCP
    … …  
    40724112         ENDIF !if callstats
    40734113     
    4074 
    40754114      IF (lafin) THEN
    40764115         itau_phy = itau_phy + itap

  • LMDZ5/branches/testing/libf/phylmd/phystokenc.F90

    r1539 r1795  
    1212  USE iophy
    1313  USE control_mod
     14  USE indice_sol_mod
    1415 
    1516  IMPLICIT NONE
    … …  
    2223  INCLUDE "dimensions.h"
    2324  INCLUDE "tracstoke.h"
    24   INCLUDE "indicesol.h"
    2525  INCLUDE "iniprint.h"
    2626!======================================================================

  • LMDZ5/branches/testing/libf/phylmd/phytrac.F90

    r1750 r1795  
    4545  USE tracreprobus_mod
    4646  USE control_mod
     47  USE indice_sol_mod
    4748
    4849  IMPLICIT NONE
    … …  
    5051  INCLUDE "YOMCST.h"
    5152  INCLUDE "dimensions.h"
    52   INCLUDE "indicesol.h"
    5353  INCLUDE "clesphys.h"
    5454  INCLUDE "temps.h"
    … …  
    203203  INTEGER                   :: itau_w      ! pas de temps ecriture = nstep + itau_phy
    204204  LOGICAL,PARAMETER         :: ok_sync=.TRUE.
    205   CHARACTER(len=20)         :: chtratimestep
    206 
     205  CHARACTER(len=20),save    :: chtratimestep,chtratimestep_omp
     206!$OMP THREADPRIVATE(chtratimestep)
    207207!
    208208! Nature du traceur
    … …  
    264264  CHARACTER(len=8),DIMENSION(nbtr) :: solsym
    265265!RomP >>>
    266   INTEGER,SAVE  :: iflag_lscav
    267   LOGICAL,SAVE  :: convscav
     266  INTEGER,SAVE  :: iflag_lscav_omp,iflag_lscav
     267  LOGICAL,SAVE  :: convscav_omp,convscav
    268268!$OMP THREADPRIVATE(iflag_lscav,convscav)
    269269!RomP <<<
    … …  
    309309  IF (debutphy) THEN
    310310!!jyg
    311    chtratimestep='DefFreq'
    312    CALL getin('tra_time_step',chtratimestep)
     311!$OMP MASTER
     312   chtratimestep_omp='DefFreq'
     313   CALL getin('tra_time_step',chtratimestep_omp)
     314!$OMP END MASTER
     315!$OMP BARRIER
     316   chtratimestep=chtratimestep_omp
    313317   IF (chtratimestep .NE. 'DefFreq') THEN
    314318     call convers_timesteps(chtratimestep,pdtphys,ecrit_tra)
    … …  
    321325!Config Help =
    322326!
    323   convscav=.false.
    324   call getin('convscav', convscav)
     327!$OMP MASTER
     328  convscav_omp=.false.
     329  call getin('convscav', convscav_omp)
     330!$OMP END MASTER
     331!$OMP BARRIER
     332  convscav=convscav_omp
    325333  print*,'phytrac passage dans routine conv avec lessivage', convscav
    326334!
    … …  
    331339!Config Help =
    332340!
    333   iflag_lscav=1
    334   call getin('iflag_lscav', iflag_lscav)
     341!$OMP MASTER
     342  iflag_lscav_omp=1
     343  call getin('iflag_lscav', iflag_lscav_omp)
     344!$OMP END MASTER
     345!$OMP BARRIER
     346  iflag_lscav=iflag_lscav_omp
    335347!
    336348  SELECT CASE(iflag_lscav)
    … …  
    371383     INCLUDE "ini_histrac.h"
    372384#endif
    373   END IF
     385  END IF ! of IF (debutphy)
    374386!############################################ END INITIALIZATION #######
    375387

  • LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90

    r1707 r1795  
    1111   cldfra, cldemi, cldtaupd,&
    1212   ok_ade, ok_aie, flag_aerosol,&
     13   flag_aerosol_strat,&
    1314   tau_aero, piz_aero, cg_aero,&
    1415   cldtaupi, new_aod, &
    … …  
    5758  ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
    5859  ! flag_aerosol-input-I- aerosol flag from 0 to 6
     60  ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F)
    5961  ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
    6062  ! cldtaupi-input-R- epaisseur optique des nuages dans le visible
    … …  
    121123  LOGICAL, INTENT(in)  :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
    122124  INTEGER, INTENT(in)  :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
     125  LOGICAL, INTENT(in)  :: flag_aerosol_strat                             ! use stratospheric aerosols
    123126  REAL,    INTENT(in)  :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
    124127  REAL,    INTENT(in)  :: tau_aero(KLON,KLEV,9,2)                        ! aerosol optical properties (see aeropt.F)
    … …  
    360363               ztopswadaero,zsolswadaero,&
    361364               ztopswaiaero,zsolswaiaero,&
    362                ok_ade, ok_aie, flag_aerosol)
     365               ok_ade, ok_aie)
    363366         
    364367       ELSE ! new_aod=T         
    … …  
    379382               zsolsw_aero,zsolsw0_aero,&
    380383               ztopswcf_aero,zsolswcf_aero, &
    381                ok_ade, ok_aie, flag_aerosol)
     384               ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat)
    382385       ENDIF
    383386

  • LMDZ5/branches/testing/libf/phylmd/read_pstoke.F

    r1403 r1795  
    2121      USE dimphy
    2222      USE control_mod
     23      USE indice_sol_mod
    2324
    2425       IMPLICIT NONE
    … …  
    3435#include "description.h"
    3536#include "serre.h"
    36 #include "indicesol.h"
    3737cccc#include "dimphy.h"
    3838       

  • LMDZ5/branches/testing/libf/phylmd/read_pstoke0.F

    r1403 r1795  
    1717C******************************************************************************
    1818
    19         use netcdf
     19         USE netcdf
    2020       USE dimphy
    2121       USE control_mod
     22       USE indice_sol_mod
    2223
    2324       IMPLICIT NONE
    … …  
    3334#include "description.h"
    3435#include "serre.h"
    35 #include "indicesol.h"
    3636cccc#include "dimphy.h"
    3737         

  • LMDZ5/branches/testing/libf/phylmd/screenc.F90

    r793 r1795  
    2222! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    2323! knon----input-I- nombre de points pour un type de surface
    24 ! nsrf----input-I- indice pour le type de surface; voir indicesol.h
     24! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    2525! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
    2626! speed---input-R- module du vent au 1er niveau du modele

  • LMDZ5/branches/testing/libf/phylmd/screenp.F90

    r1107 r1795  
    2222! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    2323! knon----input-I- nombre de points pour un type de surface
    24 ! nsrf----input-I- indice pour le type de surface; voir indicesol.h
     24! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    2525! speed---input-R- module du vent au 1er niveau du modele
    2626! tair----input-R- temperature de l'air au 1er niveau du modele

  • LMDZ5/branches/testing/libf/phylmd/soil.F90

    r1664 r1795  
    77  USE dimphy
    88  USE mod_phys_lmdz_para
     9  USE indice_sol_mod
     10
    911  IMPLICIT NONE
    1012
    … …  
    5254  INCLUDE "YOMCST.h"
    5355  INCLUDE "dimsoil.h"
    54   INCLUDE "indicesol.h"
    5556  INCLUDE "comsoil.h"
    5657  INCLUDE "iniprint.h"

  • LMDZ5/branches/testing/libf/phylmd/stdlevvar.F90

    r793 r1795  
    2323! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    2424! knon----input-I- nombre de points pour un type de surface
    25 ! nsrf----input-I- indice pour le type de surface; voir indicesol.h
     25! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    2626! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
    2727! u1------input-R- vent zonal au 1er niveau du modele

  • LMDZ5/branches/testing/libf/phylmd/stratocu_if.F90

    r878 r1795  
    11  SUBROUTINE stratocu_if(klon,klev,pctsrf,paprs, pplay,t &
    22,seuil_inversion,weak_inversion,dthmin)
    3 implicit none
     3
     4  USE indice_sol_mod
     5
     6IMPLICIT NONE
    47
    58!======================================================================
    … …  
    3942    REAL dthmin(klon), zdthdp
    4043
    41     INCLUDE "indicesol.h"
    4244    INCLUDE "YOMCST.h"
    4345

  • LMDZ5/branches/testing/libf/phylmd/surf_land_bucket_mod.F90

    r1750 r1795  
    2727    USE mod_grid_phy_lmdz
    2828    USE mod_phys_lmdz_para
     29    USE indice_sol_mod
    2930!****************************************************************************************
    3031! Bucket calculations for surface.
    3132!
    3233    INCLUDE "clesphys.h"
    33     INCLUDE "indicesol.h"
    3434    INCLUDE "dimsoil.h"
    3535    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phylmd/surf_land_mod.F90

    r1146 r1795  
    3131    USE surf_land_bucket_mod
    3232    USE calcul_fluxs_mod
     33    USE indice_sol_mod
    3334
    34     INCLUDE "indicesol.h"
    3535    INCLUDE "dimsoil.h"
    3636    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phylmd/surf_land_orchidee_mod.F90

    r1454 r1795  
    4444    USE mod_synchro_omp
    4545    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
     46    USE indice_sol_mod
    4647
    4748!   
    … …  
    9798!   qsurf        air moisture at surface
    9899!
    99     INCLUDE "indicesol.h"
    100100    INCLUDE "temps.h"
    101101    INCLUDE "YOMCST.h"
    … …  
    551551    USE mod_grid_phy_lmdz
    552552    USE mod_surf_para   
    553     INCLUDE "indicesol.h"
     553    USE indice_sol_mod
    554554
    555555#ifdef CPP_MPI

  • LMDZ5/branches/testing/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90

    r1548 r1795  
    9797!
    9898    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
     99    USE indice_sol_mod
    99100    IMPLICIT NONE
    100101
    101     INCLUDE "indicesol.h"
    102102    INCLUDE "temps.h"
    103103    INCLUDE "YOMCST.h"
    … …  
    634634  SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
    635635   
    636     INCLUDE "indicesol.h"
     636    USE indice_sol_mod
     637
    637638    INCLUDE "dimensions.h"
    638639#ifdef CPP_MPI

  • LMDZ5/branches/testing/libf/phylmd/surf_landice_mod.F90

    r1403 r1795  
    2525    USE calcul_fluxs_mod
    2626    USE phys_output_var_mod
    27 
    28     INCLUDE "indicesol.h"
     27    USE indice_sol_mod
     28
     29!    INCLUDE "indicesol.h"
    2930    INCLUDE "dimsoil.h"
    3031    INCLUDE "YOMCST.h"

  • LMDZ5/branches/testing/libf/phylmd/surf_ocean_mod.F90

    r1403 r1795  
    2525  USE ocean_slab_mod, ONLY   : ocean_slab_noice
    2626  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
     27  USE indice_sol_mod
    2728!
    2829! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
    2930! slab or couple). The calculations of albedo and rugosity for the ocean surface are
    3031! done in here because they are identical for the different modes of ocean.
    31 !
    32     INCLUDE "indicesol.h"
     32
     33
    3334    INCLUDE "YOMCST.h"
    3435

  • LMDZ5/branches/testing/libf/phylmd/surf_seaice_mod.F90

    r1072 r1795  
    2525  USE ocean_forced_mod, ONLY : ocean_forced_ice
    2626  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
     27  USE indice_sol_mod
    2728
    2829!
    … …  
    3132! in here because it is the same calculation for the different modes of ocean.
    3233!
    33     INCLUDE "indicesol.h"
    3434    INCLUDE "dimsoil.h"
    3535

  • LMDZ5/branches/testing/libf/phylmd/sw_aeroAR4.F90

    r1669 r1795  
    1818     PSOLSWAERO,PSOLSW0AERO,&
    1919     PTOPSWCFAERO,PSOLSWCFAERO,&
    20      ok_ade, ok_aie, flag_aerosol )
     20     ok_ade, ok_aie, flag_aerosol, flag_aerosol_strat )
    2121
    2222  USE dimphy
    … …  
    138138
    139139  LOGICAL ok_ade, ok_aie    ! use aerosol forcings or not?
     140  LOGICAL flag_aerosol_strat ! use stratospehric aerosols
    140141  INTEGER flag_aerosol      ! global flag for aerosol 0 (no aerosol) or 1-5 (aerosols)
    141142  REAL(KIND=8) tauaero(kdlon,kflev,9,2)  ! aerosol optical properties
    … …  
    307308     ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
    308309
    309      IF (flag_aerosol .GT. 0 ) THEN
     310     IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
    310311
    311312     IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
    … …  
    498499     ENDIF ! ok_aie     
    499500
    500      ENDIF !--if flag_aerosol GT 0
     501     ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
    501502
    502503     itapsw = 0
    … …  
    504505  itapsw = itapsw + 1
    505506
    506   IF  ( AEROSOLFEEDBACK_ACTIVE .AND. flag_aerosol .GT. 0 ) THEN
     507  IF  ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
    507508  IF ( ok_ade .and. ok_aie  ) THEN
    508509    ZFSUP(:,:) =    ZFSUP_AERO(:,:,4)

  • LMDZ5/branches/testing/libf/phylmd/thermcell_main.F90

    r1750 r1795  
    1919     &                  ,alp_bl_conv,alp_bl_stat &
    2020!!! fin nrlmd le 10/04/2012
    21      &                         )
     21     &                  ,ztva  )
    2222
    2323      USE dimphy
    2424      USE ioipsl
    2525      USE comgeomphy , ONLY:rlond,rlatd
     26      USE indice_sol_mod
    2627      IMPLICIT NONE
    2728
    … …  
    6768#include "iniprint.h"
    6869#include "thermcell.h"
    69 !!! nrlmd le 10/04/2012
    70 #include "indicesol.h"
    71 !!! fin nrlmd le 10/04/2012
    7270
    7371!   arguments:

  • LMDZ5/branches/testing/libf/phylmd/tracinca_mod.F90

    r1403 r1795  
    4646    USE comgeomphy
    4747    USE control_mod
     48    USE indice_sol_mod
    4849
    4950   
    5051    IMPLICIT NONE
    5152   
    52     INCLUDE "indicesol.h"
    5353    INCLUDE "dimensions.h"
    5454    INCLUDE "paramet.h"

  • LMDZ5/branches/testing/libf/phylmd/traclmdz_mod.F90

    r1750 r1795  
    9595    USE mod_grid_phy_lmdz
    9696    USE mod_phys_lmdz_para
    97 
    98     INCLUDE "indicesol.h"
     97    USE indice_sol_mod
     98
    9999    INCLUDE "iniprint.h"
    100100! Input variables
    … …  
    346346    USE o3_chem_m, ONLY: o3_chem
    347347    USE carbon_cycle_mod, ONLY : carbon_cycle, carbon_cycle_tr, carbon_cycle_cpl
     348    USE indice_sol_mod
     349
    348350    INCLUDE "YOMCST.h"
    349     INCLUDE "indicesol.h"
    350351
    351352!==========================================================================
Note: See TracChangeset for help on using the changeset viewer.