Changeset 1001 for LMDZ4/trunk


Ignore:
Timestamp:
Oct 6, 2008, 11:11:53 AM (16 years ago)
Author:
Laurent Fairhead
Message:
  • Modifs sur le parallelisme: masquage dans la physique
  • Inclusion strato
  • mise en coherence etat0
  • le mode offline fonctionne maintenant en parallele,
  • les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
  • la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
  • L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF

Location:
LMDZ4/trunk/libf/phylmd
Files:
4 added
18 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/clesphys.h

    r998 r1001  
    4848       INTEGER :: ip_ebil_phy, iflag_rrtm
    4949       LOGICAL ok_slab_sicOBS
     50       LOGICAL :: ok_strato
     51       LOGICAL :: ok_hines
    5052
    5153       COMMON/clesphys/cycle_diurne, soil_model, new_oliq,              &
    … …  
    6264     &     , freq_ISCCP, ecrit_ISCCP, ip_ebil_phy                       &
    6365     &     , ok_slab_sicOBS, ok_lic_melt, cvl_corr                      &
    64      &     , qsol0, iflag_rrtm
     66     &     , qsol0, iflag_rrtm, ok_strato,ok_hines
    6567     
    6668!$OMP THREADPRIVATE(/clesphys/)

  • LMDZ4/trunk/libf/phylmd/conf_phys.F90

    r998 r1001  
     1
    12!
    23! $Header$
    … …  
    120121  LOGICAL,SAVE :: ok_lic_melt_omp
    121122!
    122 !
    123     LOGICAL,SAVE :: cycle_diurne_omp,soil_model_omp,new_oliq_omp
    124     LOGICAL,SAVE :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
    125     INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
    126 !
    127 
    128 !$OMP MASTER
     123  LOGICAL,SAVE :: cycle_diurne_omp,soil_model_omp,new_oliq_omp
     124  LOGICAL,SAVE :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
     125  INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
     126  LOGICAL,SAVE :: ok_strato_omp
     127  LOGICAL,SAVE :: ok_hines_omp
     128!
     129
     130!$OMP MASTER
    129131!Config Key  = OCEAN
    130132!Config Desc = Type d'ocean
    … …  
    10941096  call getin('alphas',alphas_omp)
    10951097
     1098!Config key = ok_strato
     1099!Config  Desc = activation de la version strato
     1100!Config  Def  = .FALSE.
     1101!Config  Help = active la version stratosphérique de LMDZ de F. Lott
     1102
     1103  ok_strato_omp=.FALSE.
     1104  CALL getin('ok_strato',ok_strato_omp)
     1105     
     1106!Config  key = ok_hines
     1107!Config  Desc = activation de la parametrisation de hines
     1108!Config  Def  = .FALSE.
     1109!Config  Help = Clefs controlant la parametrization de Hines
     1110!               Et la sponge layer (Runs Stratospheriques)
     1111
     1112  ok_hines_omp=.FALSE.
     1113  CALL getin('ok_hines',ok_hines_omp)
    10961114
    10971115
    … …  
    12101228    Fmax = Fmax_omp
    12111229    alphas = alphas_omp
    1212 
    1213 !$OMP MASTER
     1230    ok_strato = ok_strato_omp
     1231    ok_hines = ok_hines_omp
     1232   
    12141233
    12151234! Attribution of new parmeters according to parameters in .def
    … …  
    12301249       CALL abort_gcm('conf_phys','ocean not valid',1)
    12311250    END IF
     1251
     1252!$OMP MASTER
    12321253
    12331254  write(numout,*)' ##############################################'
    … …  
    13271348 & ecrit_hf, ecrit_day, ecrit_mth, ecrit_reg, ecrit_tra, ecrit_ISCCP
    13281349
     1350  write(numout,*) 'ok_strato = ', ok_strato
     1351  write(numout,*) 'ok_hines = ',  ok_hines
     1352 
    13291353!$OMP END MASTER
    13301354

  • LMDZ4/trunk/libf/phylmd/cpl_mod.F90

    r996 r1001  
    8585  !$OMP THREADPRIVATE(cpl_windsp2D)
    8686 
    87 ! variables for OPENMP parallelisation
     87! variable for OPENMP parallelisation
     88
    8889  INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp
    8990  REAL,ALLOCATABLE,DIMENSION(:,:),SAVE ::  buffer_omp
    9091 
    91 
    9292CONTAINS
    9393!
    … …  
    255255
    256256!$OMP MASTER
    257     ALLOCATE(knon_omp(0:omp_size-1))
    258     ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))       
     257  ALLOCATE(knon_omp(0:omp_size-1))
     258  ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))       
    259259!$OMP END MASTER
    260260!$OMP BARRIER
    … …  
    311311       time_sec=(itime-1)*dtime
    312312#ifdef CPP_COUPLE
     313    il_time_secs=(itime-1)*dtime
    313314!$OMP MASTER
    314        CALL fromcpl(time_sec, tab_read_flds)
     315    CALL fromcpl(il_time_secs, tab_read_flds)
    315316!$OMP END MASTER
    316317#endif
    … …  
    324325          END DO
    325326       ENDIF
     327
    326328
    327329! Save each field in a 2D array.
    … …  
    945947    REAL, DIMENSION(klon_mpi)                            :: rlon_mpi, rlat_mpi
    946948
    947 #ifdef CPP_PARA
     949#ifdef CPP_MPI
    948950    INCLUDE 'mpif.h'
    949951    INTEGER, DIMENSION(MPI_STATUS_SIZE)                  :: status
    … …  
    10011003    IF (is_omp_root) THEN
    10021004
    1003        DO j = 1, jj_nb
    1004           tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
    1005                pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
    1006        ENDDO
    1007        
    1008    
    1009        IF (is_parallel) THEN
     1005      DO j = 1, jj_nb
     1006         tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
     1007              pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
     1008      ENDDO
     1009   
     1010   
     1011      IF (is_parallel) THEN
    10101012         IF (.NOT. is_north_pole) THEN
    1011 #ifdef CPP_PARA
     1013#ifdef CPP_MPI
    10121014            CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
    10131015            CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
    10141016#endif
    10151017         ENDIF
    1016           
     1018       
    10171019         IF (.NOT. is_south_pole) THEN
    1018 #ifdef CPP_PARA
     1020#ifdef CPP_MPI
    10191021            CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
    10201022            CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
    … …  
    10951097
    10961098! Transform the longitudes and latitudes on 2D arrays
     1099   
    10971100    CALL gather_omp(rlon,rlon_mpi)
    10981101    CALL gather_omp(rlat,rlat_mpi)
    … …  
    11621165    time_sec=(itime-1)*dtime
    11631166#ifdef CPP_COUPLE
     1167    il_time_secs=(itime-1)*dtime
    11641168!$OMP MASTER
    1165     CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
     1169    CALL intocpl(il_time_secs, lafin, tab_flds(:,:,:))
    11661170!$OMP END MASTER
    11671171#endif
    … …  
    11881192!
    11891193  SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
    1190     USE mod_phys_lmdz_para
     1194  USE mod_phys_lmdz_para
    11911195! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
    11921196! au coupleur.
    … …  
    12181222!*************************************************************************************
    12191223!
     1224   
     1225
    12201226! Transform from 2 dimensions (iim,jj_nb) to 1 dimension (klon)
    12211227!$OMP MASTER
    … …  
    12301236       champ_out(i) = temp_omp(ig)
    12311237    ENDDO
    1232    
     1238
    12331239  END SUBROUTINE cpl2gath
    12341240!

  • LMDZ4/trunk/libf/phylmd/iophy.F90

    r931 r1001  
    1616  INTERFACE histwrite_phy
    1717    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
    18   END INTERFACE
     18  END INTERFACE
     19
    1920
    2021contains
     22
     23  subroutine init_iophy_new(rlat,rlon)
     24  USE dimphy
     25  USE mod_phys_lmdz_para
     26  USE mod_grid_phy_lmdz
     27  USE ioipsl
     28  implicit none
     29  include 'dimensions.h'   
     30    real,dimension(klon),intent(in) :: rlon
     31    real,dimension(klon),intent(in) :: rlat
     32
     33    REAL,dimension(klon_glo)        :: rlat_glo
     34    REAL,dimension(klon_glo)        :: rlon_glo
     35   
     36    INTEGER,DIMENSION(2) :: ddid
     37    INTEGER,DIMENSION(2) :: dsg
     38    INTEGER,DIMENSION(2) :: dsl
     39    INTEGER,DIMENSION(2) :: dpf
     40    INTEGER,DIMENSION(2) :: dpl
     41    INTEGER,DIMENSION(2) :: dhs
     42    INTEGER,DIMENSION(2) :: dhe
     43    INTEGER :: i   
     44
     45    CALL gather(rlat,rlat_glo)
     46    CALL bcast(rlat_glo)
     47    CALL gather(rlon,rlon_glo)
     48    CALL bcast(rlon_glo)
     49   
     50!$OMP MASTER 
     51    ALLOCATE(io_lat(jjm+1-1/iim))
     52    io_lat(1)=rlat_glo(1)
     53    io_lat(jjm+1-1/iim)=rlat_glo(klon_glo)
     54    IF (iim > 1) then
     55      DO i=2,jjm
     56        io_lat(i)=rlat_glo(2+(i-2)*iim)
     57      ENDDO
     58    ENDIF
     59
     60    ALLOCATE(io_lon(iim))
     61    io_lon(:)=rlon_glo(2-1/iim:iim+1-1/iim)
     62
     63
     64    allocate(tmp_tab2d(iim,jj_nb))
     65    allocate(tmp_tab3d(iim,jj_nb,klev))
     66    allocate(ndex2d(iim*jj_nb))
     67    allocate(ndex3d(iim*jj_nb*klev))
     68    ndex2d(:)=0
     69    ndex3d(:)=0
     70   
     71    ddid=(/ 1,2 /)
     72    dsg=(/ iim, jjm+1-1/iim /)
     73    dsl=(/ iim, jj_nb /)
     74    dpf=(/ 1,jj_begin /)
     75    dpl=(/ iim, jj_end /)
     76    dhs=(/ ii_begin-1,0 /)
     77    if (mpi_rank==mpi_size-1) then
     78      dhe=(/0,0/)
     79    else
     80      dhe=(/ iim-ii_end,0 /) 
     81    endif
     82   
     83    call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
     84                      'APPLE',phys_domain_id)
     85
     86!$OMP END MASTER
     87     
     88  end subroutine init_iophy_new
    2189
    2290  subroutine init_iophy(lat,lon)
    … …  
    139207 
    140208 
    141 !  subroutine phy2dyn(field_phy,field_dyn,nlev)
    142 !  USE dimphy_old
    143 !  implicit none
    144 !  include 'dimensions.h'
    145 ! 
    146 !    real,dimension(klon_mpi,nlev),intent(in) :: field_phy
    147 !    real,dimension(iim,jjphy_nb,nlev),intent(out) :: field_dyn
    148 !    integer,intent(in) :: nlev
    149 !   
    150 !    integer :: next
    151 !    integer :: j,l
    152 !   
    153 !      do l=1,nlev
    154 !               
    155 !       if (jjphy_begin==jjphy_end) then
    156 !         field_dyn(:,1,l)=0.
    157 !         field_dyn(iiphy_begin:iiphy_end,1,l)=field_phy(1:klon_mpi,l)
    158 !       else
    159 !       
    160 !        if (jjphy_begin==1) then
    161 !           field_dyn(:,1,l)=field_phy(1,l)
    162 !           next=2
    163 !        else
    164 !          field_dyn(:,1,l)=0.
    165 !          next=iim-iiphy_begin+2
    166 !          field_dyn(iiphy_begin:iim,1,l)=field_phy(1:next-1,l)   
    167 !        endif
    168 !       
    169 !         do j=2,jjphy_nb-1
    170 !           field_dyn(:,j,l)=field_phy(next:next+iim-1,l)
    171 !           next=next+iim
    172 !         enddo
    173 !         
    174 !         if (jjphy_end==jjm+1-1/iim) then
    175 !             field_dyn(:,jjphy_nb,l)=field_phy(klon_mpi,l)
    176 !         else
    177 !          field_dyn(:,jjphy_nb,l)=0.
    178 !          field_dyn(1:iiphy_end,jjphy_nb,l)=field_phy(next:next+iiphy_end-1,l)   
    179 !         endif
    180 !         
    181 !       endif
    182 !     
    183 !     enddo
    184 !       
    185 !    end subroutine phy2dyn         
    186  
    187          
     209
    188210end module iophy

  • LMDZ4/trunk/libf/phylmd/limit_read_mod.F90

    r996 r1001  
    1515
    1616  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE, PRIVATE :: pctsrf
     17!$OMP THREADPRIVATE(pctsrf)
    1718  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: rugos
     19!$OMP THREADPRIVATE(rugos)
    1820  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: albedo
     21!$OMP THREADPRIVATE(albedo) 
    1922  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sst
    20   LOGICAL :: read_continents=.FALSE.
     23!$OMP THREADPRIVATE(sst) 
     24  LOGICAL,SAVE :: read_continents=.FALSE.
     25!$OMP THREADPRIVATE(read_continents)
    2126
    2227CONTAINS
    … …  
    157162!****************************************************************************************
    158163! frequence de lecture des conditions limites (en pas de physique)
    159     INTEGER,SAVE                              :: lmt_pas   
     164    INTEGER,SAVE                              :: lmt_pas
     165!$OMP THREADPRIVATE(lmt_pas)
    160166    LOGICAL, SAVE                             :: first_call=.TRUE.
    161    
     167!$OMP THREADPRIVATE(first_call)   
    162168! Locals variables
    163169!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/limit_slab.F90

    r996 r1001  
    2525!****************************************************************************************
    2626  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: bils_save, foce_save
     27!$OMP THREADPRIVATE(bils_save, foce_save)
    2728
    2829! Locals variables

  • LMDZ4/trunk/libf/phylmd/mod_grid_phy_lmdz.F90

    r775 r1001  
    33!
    44MODULE mod_grid_phy_lmdz
    5   INTEGER :: nbp_lon  ! == iim
    6   INTEGER :: nbp_lat  ! == jjmp1
    7   INTEGER :: nbp_lev  ! == llm
    8   INTEGER :: klon_glo
     5  INTEGER,SAVE :: nbp_lon  ! == iim
     6  INTEGER,SAVE :: nbp_lat  ! == jjmp1
     7  INTEGER,SAVE :: nbp_lev  ! == llm
     8  INTEGER,SAVE :: klon_glo
    99
    1010  INTERFACE grid1dTo2d_glo

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_mpi_data.F90

    r879 r1001  
    3737  INTEGER,SAVE :: mpi_root
    3838  LOGICAL,SAVE :: is_mpi_root
    39   LOGICAL,SAVE :: is_ok_mpi
     39  LOGICAL,SAVE :: is_using_mpi
    4040 
    4141 
    … …  
    5858    INTEGER :: i
    5959   
    60 #ifdef CPP_PARA
    61     is_ok_mpi=.TRUE.
     60#ifdef CPP_MPI
     61    is_using_mpi=.TRUE.
    6262#else
    63     is_ok_mpi=.FALSE.
     63    is_using_mpi=.FALSE.
    6464#endif
    6565   
    … …  
    7272    COMM_LMDZ_PHY=COMM_LMDZ
    7373
    74     IF (is_ok_mpi) THEN   
    75 #ifdef CPP_PARA
     74    IF (is_using_mpi) THEN   
     75#ifdef CPP_MPI
    7676      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)   
    7777      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_mpi_transfert.F90

    r775 r1001  
    6666    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
    6767   
    68 #ifndef CPP_PARA
    69     RETURN
    70 #endif
    71 
    7268    CALL bcast_mpi_cgen(Var1,len(Var1))
     69
    7370  END SUBROUTINE bcast_mpi_c
    7471
    7572!! -- Les entiers -- !!
    7673 
    77   SUBROUTINE bcast_mpi_i(var1)
     74  SUBROUTINE bcast_mpi_i(var)
     75  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
    7876  IMPLICIT NONE
    79     INTEGER,INTENT(INOUT) :: Var1
    80    
    81 #ifndef CPP_PARA
    82     RETURN
    83 #endif
    84     CALL bcast_mpi_igen(Var1,1)
     77    INTEGER,INTENT(INOUT) :: Var
     78   
     79    INTEGER               :: var_tmp(1)
     80   
     81    IF (is_mpi_root) var_tmp(1)=var
     82    CALL bcast_mpi_igen(Var_tmp,1)
     83    var=var_tmp(1)
     84   
    8585  END SUBROUTINE bcast_mpi_i
    8686
    … …  
    8888  IMPLICIT NONE
    8989    INTEGER,INTENT(INOUT) :: Var(:)
    90    
    91 #ifndef CPP_PARA
    92     RETURN
    93 #endif
     90
    9491    CALL bcast_mpi_igen(Var,size(Var))
     92   
    9593  END SUBROUTINE bcast_mpi_i1
    9694
    … …  
    9997    INTEGER,INTENT(INOUT) :: Var(:,:)
    10098   
    101 #ifndef CPP_PARA
    102     RETURN
    103 #endif
    10499    CALL bcast_mpi_igen(Var,size(Var))
     100 
    105101  END SUBROUTINE bcast_mpi_i2
    106102
    … …  
    109105    INTEGER,INTENT(INOUT) :: Var(:,:,:)
    110106   
    111 #ifndef CPP_PARA
    112     RETURN
    113 #endif
    114107    CALL bcast_mpi_igen(Var,size(Var))
     108
    115109  END SUBROUTINE bcast_mpi_i3
    116110
    … …  
    119113    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
    120114   
    121 #ifndef CPP_PARA
    122     RETURN
    123 #endif
    124115    CALL bcast_mpi_igen(Var,size(Var))
     116
    125117  END SUBROUTINE bcast_mpi_i4
    126118
    … …  
    129121
    130122  SUBROUTINE bcast_mpi_r(var)
     123  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
    131124  IMPLICIT NONE
    132125    REAL,INTENT(INOUT) :: Var
    133    
    134 #ifndef CPP_PARA
    135     RETURN
    136 #endif
    137     CALL bcast_mpi_rgen(Var,1)
     126    REAL               :: var_tmp(1)
     127   
     128    IF (is_mpi_root) var_tmp(1)=var
     129    CALL bcast_mpi_rgen(Var_tmp,1)
     130    var=var_tmp(1)   
     131
    138132  END SUBROUTINE bcast_mpi_r
    139133
    … …  
    142136    REAL,INTENT(INOUT) :: Var(:)
    143137   
    144 #ifndef CPP_PARA
    145     RETURN
    146 #endif
    147138    CALL bcast_mpi_rgen(Var,size(Var))
     139
    148140  END SUBROUTINE bcast_mpi_r1
    149141
    … …  
    152144    REAL,INTENT(INOUT) :: Var(:,:)
    153145   
    154 #ifndef CPP_PARA
    155     RETURN
    156 #endif
    157146    CALL bcast_mpi_rgen(Var,size(Var))
     147
    158148  END SUBROUTINE bcast_mpi_r2
    159149
    … …  
    162152    REAL,INTENT(INOUT) :: Var(:,:,:)
    163153   
    164 #ifndef CPP_PARA
    165     RETURN
    166 #endif
    167154    CALL bcast_mpi_rgen(Var,size(Var))
     155
    168156  END SUBROUTINE bcast_mpi_r3
    169157
    … …  
    172160    REAL,INTENT(INOUT) :: Var(:,:,:,:)
    173161   
    174 #ifndef CPP_PARA
    175     RETURN
    176 #endif
    177162    CALL bcast_mpi_rgen(Var,size(Var))
     163
    178164  END SUBROUTINE bcast_mpi_r4
    179165 
    … …  
    181167
    182168  SUBROUTINE bcast_mpi_l(var)
     169  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
    183170  IMPLICIT NONE
    184171    LOGICAL,INTENT(INOUT) :: Var
    185    
    186 #ifndef CPP_PARA
    187     RETURN
    188 #endif
    189     CALL bcast_mpi_lgen(Var,1)
     172    LOGICAL               :: var_tmp(1)
     173   
     174    IF (is_mpi_root) var_tmp(1)=var
     175    CALL bcast_mpi_lgen(Var_tmp,1)
     176    var=var_tmp(1)   
     177
    190178  END SUBROUTINE bcast_mpi_l
    191179
    … …  
    194182    LOGICAL,INTENT(INOUT) :: Var(:)
    195183   
    196 #ifndef CPP_PARA
    197     RETURN
    198 #endif
    199184    CALL bcast_mpi_lgen(Var,size(Var))
     185
    200186  END SUBROUTINE bcast_mpi_l1
    201187
    … …  
    204190    LOGICAL,INTENT(INOUT) :: Var(:,:)
    205191   
    206 #ifndef CPP_PARA
    207     RETURN
    208 #endif
    209192    CALL bcast_mpi_lgen(Var,size(Var))
     193
    210194  END SUBROUTINE bcast_mpi_l2
    211195
    … …  
    214198    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
    215199   
    216 #ifndef CPP_PARA
    217     RETURN
    218 #endif
    219200    CALL bcast_mpi_lgen(Var,size(Var))
     201
    220202  END SUBROUTINE bcast_mpi_l3
    221203
    … …  
    224206    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
    225207   
    226 #ifndef CPP_PARA
    227     RETURN
    228 #endif
    229208    CALL bcast_mpi_lgen(Var,size(Var))
     209
    230210  END SUBROUTINE bcast_mpi_l4
    231211 
    … …  
    241221    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    242222
    243     INTEGER :: dummy
    244 
    245 #ifndef CPP_PARA
    246     VarOut(:)=VarIn(:)
    247     RETURN
    248 #endif
    249 
    250      IF (is_mpi_root) THEN
    251       CALL scatter_mpi_igen(VarIn,Varout,1)
    252      ELSE
    253       CALL scatter_mpi_igen(dummy,Varout,1)
    254     ENDIF
     223    CALL scatter_mpi_igen(VarIn,Varout,1)
    255224   
    256225  END SUBROUTINE scatter_mpi_i
    … …  
    263232    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    264233   
    265     INTEGER :: dummy
    266 
    267 #ifndef CPP_PARA
    268     VarOut(:,:)=VarIn(:,:)
    269     RETURN
    270 #endif
    271     IF (is_mpi_root) THEN
    272       CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
    273     ELSE
    274       CALL scatter_mpi_igen(dummy,Varout,Size(VarOut,2))
    275     ENDIF
     234    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
    276235   
    277236  END SUBROUTINE scatter_mpi_i1
    … …  
    284243    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    285244   
    286     INTEGER :: dummy
    287    
    288 #ifndef CPP_PARA
    289     VarOut(:,:,:)=VarIn(:,:,:)
    290     RETURN
    291 #endif
    292     IF (is_mpi_root) THEN
    293       CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
    294     ELSE
    295       CALL scatter_mpi_igen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3))
    296     ENDIF
     245    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
     246
    297247  END SUBROUTINE scatter_mpi_i2
    298248
    … …  
    304254    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    305255   
    306     INTEGER :: dummy
    307    
    308 #ifndef CPP_PARA
    309     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    310     RETURN
    311 #endif
    312     IF (is_mpi_root) THEN
    313       CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    314     ELSE
    315       CALL scatter_mpi_igen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    316     ENDIF
     256    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    317257 
    318258  END SUBROUTINE scatter_mpi_i3
    … …  
    326266    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    327267   
    328     REAL :: dummy
    329    
    330 #ifndef CPP_PARA
    331     VarOut(:)=VarIn(:)
    332     RETURN
    333 #endif
    334     IF (is_mpi_root) THEN
    335268      CALL scatter_mpi_rgen(VarIn,Varout,1)
    336     ELSE
    337       CALL scatter_mpi_rgen(dummy,Varout,1)
    338     ENDIF
    339269 
    340270  END SUBROUTINE scatter_mpi_r
    … …  
    347277    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    348278   
    349     REAL :: dummy
    350    
    351 #ifndef CPP_PARA
    352     VarOut(:,:)=VarIn(:,:)
    353     RETURN
    354 #endif
    355     IF (is_mpi_root) THEN
    356279      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
    357     ELSE
    358       CALL scatter_mpi_rgen(dummy,Varout,Size(VarOut,2))     
    359     ENDIF
    360280 
    361281  END SUBROUTINE scatter_mpi_r1
    … …  
    368288    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    369289   
    370     REAL :: dummy
    371    
    372 #ifndef CPP_PARA
    373     VarOut(:,:,:)=VarIn(:,:,:)
    374     RETURN
    375 #endif
    376     IF (is_mpi_root) THEN
    377290      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
    378     ELSE
    379       CALL scatter_mpi_rgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3))
    380     ENDIF
    381291 
    382292  END SUBROUTINE scatter_mpi_r2
    … …  
    389299    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    390300   
    391     REAL :: dummy
    392    
    393 #ifndef CPP_PARA
    394     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    395     RETURN
    396 #endif
    397     IF (is_mpi_root) THEN
    398301      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    399     ELSE
    400       CALL scatter_mpi_rgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    401     ENDIF
    402302 
    403303  END SUBROUTINE scatter_mpi_r3
    … …  
    411311    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
    412312   
    413     LOGICAL :: dummy
    414    
    415 #ifndef CPP_PARA
    416     VarOut(:)=VarIn(:)
    417     RETURN
    418 #endif
    419     IF (is_mpi_root) THEN
    420313      CALL scatter_mpi_lgen(VarIn,Varout,1)
    421     ELSE
    422       CALL scatter_mpi_lgen(dummy,Varout,1)
    423     ENDIF
    424314   
    425315  END SUBROUTINE scatter_mpi_l
    … …  
    432322    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    433323   
    434     LOGICAL :: dummy
    435    
    436 #ifndef CPP_PARA
    437     VarOut(:,:)=VarIn(:,:)
    438     RETURN
    439 #endif
    440     IF (is_mpi_root) THEN
    441324      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
    442     ELSE
    443       CALL scatter_mpi_lgen(dummy,Varout,Size(VarOut,2))     
    444     ENDIF
    445325 
    446326  END SUBROUTINE scatter_mpi_l1
    … …  
    453333    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    454334   
    455     LOGICAL :: dummy
    456    
    457 #ifndef CPP_PARA
    458     VarOut(:,:,:)=VarIn(:,:,:)
    459     RETURN
    460 #endif
    461     IF (is_mpi_root) THEN
    462335      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
    463     ELSE
    464       CALL scatter_mpi_lgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3))
    465     ENDIF
    466336 
    467337  END SUBROUTINE scatter_mpi_l2
    … …  
    474344    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    475345   
    476     LOGICAL :: dummy
    477    
    478 #ifndef CPP_PARA
    479     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    480     RETURN
    481 #endif
    482     IF (is_mpi_root) THEN
    483346      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    484     ELSE
    485       CALL scatter_mpi_lgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
    486     ENDIF
    487347 
    488348  END SUBROUTINE scatter_mpi_l3 
    … …  
    501361    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    502362   
    503     INTEGER :: dummy
    504 
    505 #ifndef CPP_PARA
    506     VarOut(:)=VarIn(:)
    507     RETURN
    508 #endif
    509 
    510     IF (is_mpi_root) THEN
    511363      CALL gather_mpi_igen(VarIn,VarOut,1)
    512     ELSE
    513       CALL gather_mpi_igen(VarIn,dummy,1)
    514     ENDIF
    515364 
    516365  END SUBROUTINE gather_mpi_i
    517  
    518  
    519  
    520366 
    521367
    … …  
    529375    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    530376   
    531     INTEGER :: dummy
    532    
    533 #ifndef CPP_PARA
    534     VarOut(:,:)=VarIn(:,:)
    535     RETURN
    536 #endif
    537 
    538     IF (is_mpi_root) THEN
    539377      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
    540     ELSE
    541       CALL gather_mpi_igen(VarIn,dummy,Size(VarIn,2))
    542     ENDIF
    543378 
    544379  END SUBROUTINE gather_mpi_i1
    … …  
    553388    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    554389   
    555     INTEGER :: dummy
    556    
    557 #ifndef CPP_PARA
    558     VarOut(:,:,:)=VarIn(:,:,:)
    559     RETURN
    560 #endif
    561 
    562     IF (is_mpi_root) THEN
    563390      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
    564     ELSE
    565       CALL gather_mpi_igen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3))
    566     ENDIF
    567391 
    568392  END SUBROUTINE gather_mpi_i2
    … …  
    577401    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    578402   
    579     INTEGER :: dummy
    580    
    581 #ifndef CPP_PARA
    582     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    583     RETURN
    584 #endif
    585 
    586     IF (is_mpi_root) THEN
    587403      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
    588     ELSE
    589       CALL gather_mpi_igen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
    590     ENDIF
    591404 
    592405  END SUBROUTINE gather_mpi_i3
    … …  
    601414    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    602415   
    603     REAL :: dummy
    604    
    605 #ifndef CPP_PARA
    606     VarOut(:)=VarIn(:)
    607     RETURN
    608 #endif
    609 
    610     IF (is_mpi_root) THEN
    611416      CALL gather_mpi_rgen(VarIn,VarOut,1)
    612     ELSE
    613       CALL gather_mpi_rgen(VarIn,dummy,1)
    614     ENDIF
    615417 
    616418  END SUBROUTINE gather_mpi_r
    … …  
    625427    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    626428   
    627     REAL :: dummy
    628    
    629 #ifndef CPP_PARA
    630     VarOut(:,:)=VarIn(:,:)
    631     RETURN
    632 #endif
    633 
    634     IF (is_mpi_root) THEN
    635429      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
    636     ELSE
    637       CALL gather_mpi_rgen(VarIn,dummy,Size(VarIn,2))
    638     ENDIF
    639430 
    640431  END SUBROUTINE gather_mpi_r1
    … …  
    649440    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    650441   
    651     REAL :: dummy
    652    
    653 #ifndef CPP_PARA
    654     VarOut(:,:,:)=VarIn(:,:,:)
    655     RETURN
    656 #endif
    657 
    658     IF (is_mpi_root) THEN
    659442      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
    660     ELSE
    661       CALL gather_mpi_rgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3))     
    662     ENDIF
    663443 
    664444  END SUBROUTINE gather_mpi_r2
    … …  
    673453    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    674454   
    675     REAL :: dummy
    676    
    677 #ifndef CPP_PARA
    678     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    679     RETURN
    680 #endif
    681 
    682     IF (is_mpi_root) THEN
    683455      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
    684     ELSE
    685       CALL gather_mpi_rgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
    686     ENDIF
    687456 
    688457  END SUBROUTINE gather_mpi_r3
    … …  
    697466    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
    698467   
    699     LOGICAL :: dummy
    700    
    701 #ifndef CPP_PARA
    702     VarOut(:)=VarIn(:)
    703     RETURN
    704 #endif
    705 
    706     IF (is_mpi_root) THEN
    707468      CALL gather_mpi_lgen(VarIn,VarOut,1)
    708     ELSE
    709       CALL gather_mpi_lgen(VarIn,dummy,1)     
    710     ENDIF
    711469 
    712470  END SUBROUTINE gather_mpi_l
    … …  
    721479    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    722480   
    723     LOGICAL :: dummy
    724    
    725 #ifndef CPP_PARA
    726     VarOut(:,:)=VarIn(:,:)
    727     RETURN
    728 #endif
    729 
    730     IF (is_mpi_root) THEN
    731481      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
    732     ELSE
    733       CALL gather_mpi_lgen(VarIn,dummy,Size(VarIn,2))
    734     ENDIF
    735482 
    736483  END SUBROUTINE gather_mpi_l1
    … …  
    745492    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    746493   
    747     LOGICAL :: dummy
    748    
    749 #ifndef CPP_PARA
    750     VarOut(:,:,:)=VarIn(:,:,:)
    751     RETURN
    752 #endif
    753 
    754     IF (is_mpi_root) THEN
    755494      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
    756     ELSE
    757       CALL gather_mpi_lgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3))
    758     ENDIF
    759495 
    760496  END SUBROUTINE gather_mpi_l2
    … …  
    769505    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    770506   
    771     LOGICAL :: dummy
    772    
    773 #ifndef CPP_PARA
    774     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    775     RETURN
    776 #endif
    777 
    778     IF (is_mpi_root) THEN
    779       CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
    780     ELSE
    781       CALL gather_mpi_lgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))     
    782     ENDIF
     507    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
    783508 
    784509  END SUBROUTINE gather_mpi_l3
    … …  
    808533    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    809534    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    810    
    811     CALL body(VarIn,VarOut,size(VarOut,2))
    812  
    813     CONTAINS
    814       SUBROUTINE body(VarIn,VarOut,s1)
    815         INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    816         INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    817         INTEGER,INTENT(IN) :: s1
    818        
    819         INTEGER,DIMENSION(klon_glo,s1) :: Var_tmp
    820        
    821         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    822         CALL scatter_mpi(Var_tmp,VarOut)
    823       END SUBROUTINE body
     535    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
     536
     537    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     538    CALL scatter_mpi(Var_tmp,VarOut)
    824539
    825540  END SUBROUTINE scatter2D_mpi_i1
    … …  
    831546    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    832547    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    833    
    834     CALL body(VarIn,VarOut,size(VarOut,2),size(VarOut,3))
    835  
    836     CONTAINS
    837       SUBROUTINE body(VarIn,VarOut,s1,s2)
    838         INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    839         INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    840         INTEGER,INTENT(IN) :: s1,s2
    841        
    842         INTEGER,DIMENSION(klon_glo,s1,s2) :: Var_tmp
    843        
    844         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    845         CALL scatter_mpi(Var_tmp,VarOut)
    846       END SUBROUTINE body
     548
     549    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
     550
     551    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     552    CALL scatter_mpi(Var_tmp,VarOut)
    847553
    848554  END SUBROUTINE scatter2D_mpi_i2
    … …  
    854560    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    855561    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    856    
    857     CALL body(VarIn,VarOut,size(VarOut,2),size(VarOut,3),size(VarOut,4))
    858  
    859     CONTAINS
    860       SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    861         INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    862         INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    863         INTEGER,INTENT(IN) :: s1,s2,s3
    864        
    865         INTEGER,DIMENSION(klon_glo,s1,s2,s3) :: Var_tmp
    866        
    867         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    868         CALL scatter_mpi(Var_tmp,VarOut)
    869       END SUBROUTINE body
    870  
    871  
     562    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
     563
     564    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     565    CALL scatter_mpi(Var_tmp,VarOut)
     566   
    872567  END SUBROUTINE scatter2D_mpi_i3
    873568
    … …  
    894589    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    895590    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    896 
    897     CALL body(VarIn,VarOut,size(VarOut,2))
    898  
    899     CONTAINS
    900       SUBROUTINE body(VarIn,VarOut,s1)
    901         REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    902         REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    903         INTEGER,INTENT(IN) :: s1
    904        
    905         REAL,DIMENSION(klon_glo,s1) :: Var_tmp
    906        
    907         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    908         CALL scatter_mpi(Var_tmp,VarOut)
    909       END SUBROUTINE body
     591   
     592    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
     593   
     594    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     595    CALL scatter_mpi(Var_tmp,VarOut)
    910596
    911597  END SUBROUTINE scatter2D_mpi_r1
    … …  
    918604    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    919605    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    920    
    921     CALL body(VarIn,VarOut,size(VarOut,2),size(VarOut,3))
    922  
    923     CONTAINS
    924       SUBROUTINE body(VarIn,VarOut,s1,s2)
    925         REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    926         REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    927         INTEGER,INTENT(IN) :: s1,s2
    928        
    929         REAL,DIMENSION(klon_glo,s1,s2) :: Var_tmp
    930        
    931         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    932         CALL scatter_mpi(Var_tmp,VarOut)
    933       END SUBROUTINE body
     606
     607    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
     608   
     609    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     610    CALL scatter_mpi(Var_tmp,VarOut)
    934611
    935612  END SUBROUTINE scatter2D_mpi_r2
    … …  
    942619    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    943620   
    944     CALL body(VarIn,VarOut,size(VarOut,2),size(VarOut,3),size(VarOut,4))
    945  
    946     CONTAINS
    947       SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    948         REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    949         REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    950         INTEGER,INTENT(IN) :: s1,s2,s3
    951        
    952         REAL,DIMENSION(klon_glo,s1,s2,s3) :: Var_tmp
    953        
    954         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    955         CALL scatter_mpi(Var_tmp,VarOut)
    956       END SUBROUTINE body
     621    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
     622
     623    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     624    CALL scatter_mpi(Var_tmp,VarOut)
    957625 
    958626  END SUBROUTINE scatter2D_mpi_r3
    … …  
    981649    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    982650   
    983     CALL body(VarIn,VarOut,size(VarOut,2))
    984  
    985     CONTAINS
    986       SUBROUTINE body(VarIn,VarOut,s1)
    987         LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    988         LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    989         INTEGER,INTENT(IN) :: s1
    990        
    991         LOGICAL,DIMENSION(klon_glo,s1) :: Var_tmp
    992        
    993         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    994         CALL scatter_mpi(Var_tmp,VarOut)
    995       END SUBROUTINE body
     651    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
     652
     653    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     654    CALL scatter_mpi(Var_tmp,VarOut)
    996655 
    997656  END SUBROUTINE scatter2D_mpi_l1
    … …  
    1005664    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1006665   
    1007     CALL body(VarIn,VarOut,size(VarOut,2),size(VarOut,3))
    1008  
    1009     CONTAINS
    1010       SUBROUTINE body(VarIn,VarOut,s1,s2)
    1011         LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1012         LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1013         INTEGER,INTENT(IN) :: s1,s2
    1014        
    1015         LOGICAL,DIMENSION(klon_glo,s1,s2) :: Var_tmp
    1016        
    1017         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    1018         CALL scatter_mpi(Var_tmp,VarOut)
    1019       END SUBROUTINE body
     666    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
     667 
     668    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     669    CALL scatter_mpi(Var_tmp,VarOut)
    1020670
    1021671  END SUBROUTINE scatter2D_mpi_l2
    … …  
    1028678    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1029679   
    1030     CALL body(VarIn,VarOut,size(VarOut,2),size(VarOut,3),size(VarOut,4))
    1031  
    1032     CONTAINS
    1033       SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1034         LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
    1035         LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1036         INTEGER,INTENT(IN) :: s1,s2,s3
    1037        
    1038         LOGICAL,DIMENSION(klon_glo,s1,s2,s3) :: Var_tmp
    1039        
    1040         CALL grid2dTo1d_glo(VarIn,Var_tmp)
    1041         CALL scatter_mpi(Var_tmp,VarOut)
    1042       END SUBROUTINE body
     680    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
     681
     682    CALL grid2dTo1d_glo(VarIn,Var_tmp)
     683    CALL scatter_mpi(Var_tmp,VarOut)
    1043684 
    1044685  END SUBROUTINE scatter2D_mpi_l3
    … …  
    1069710    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    1070711    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1071    
    1072     CALL body(VarIn,VarOut,size(VarOut,3))
    1073  
    1074     CONTAINS
    1075       SUBROUTINE body(VarIn,VarOut,s1)
    1076         INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    1077         INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1078         INTEGER,INTENT(IN) :: s1
    1079        
    1080         INTEGER,DIMENSION(klon_glo,s1) :: Var_tmp
    1081        
    1082         CALL gather_mpi(VarIn,Var_tmp)
    1083         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1084       END SUBROUTINE body
     712
     713    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
     714
     715    CALL gather_mpi(VarIn,Var_tmp)
     716    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1085717
    1086718  END SUBROUTINE gather2D_mpi_i1
    … …  
    1092724    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1093725    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1094    
    1095     CALL body(VarIn,VarOut,size(VarOut,3),SIZE(VarOut,4))
    1096  
    1097     CONTAINS
    1098       SUBROUTINE body(VarIn,VarOut,s1,s2)
    1099         INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1100         INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1101         INTEGER,INTENT(IN) :: s1,s2
    1102        
    1103         INTEGER,DIMENSION(klon_glo,s1,s2) :: Var_tmp
    1104        
    1105         CALL gather_mpi(VarIn,Var_tmp)
    1106         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1107       END SUBROUTINE body
     726
     727    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
     728   
     729    CALL gather_mpi(VarIn,Var_tmp)
     730    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1108731
    1109732  END SUBROUTINE gather2D_mpi_i2
    … …  
    1115738    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1116739    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1117    
    1118     CALL body(VarIn,VarOut,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5))
    1119  
    1120     CONTAINS
    1121       SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1122         INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1123         INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1124         INTEGER,INTENT(IN) :: s1,s2,s3
    1125        
    1126         INTEGER,DIMENSION(klon_glo,s1,s2,s3) :: Var_tmp
    1127        
    1128         CALL gather_mpi(VarIn,Var_tmp)
    1129         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1130       END SUBROUTINE body
     740 
     741    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
     742   
     743    CALL gather_mpi(VarIn,Var_tmp)
     744    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1131745
    1132746  END SUBROUTINE gather2D_mpi_i3
    … …  
    1155769    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1156770   
    1157     CALL body(VarIn,VarOut,size(VarOut,3))
    1158  
    1159     CONTAINS
    1160       SUBROUTINE body(VarIn,VarOut,s1)
    1161         REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    1162         REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1163         INTEGER,INTENT(IN) :: s1
    1164        
    1165         REAL,DIMENSION(klon_glo,s1) :: Var_tmp
    1166        
    1167         CALL gather_mpi(VarIn,Var_tmp)
    1168         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1169       END SUBROUTINE body
     771    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
     772
     773    CALL gather_mpi(VarIn,Var_tmp)
     774    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1170775
    1171776  END SUBROUTINE gather2D_mpi_r1
    … …  
    1178783    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1179784   
    1180     CALL body(VarIn,VarOut,size(VarOut,3),SIZE(VarOut,4))
    1181  
    1182     CONTAINS
    1183       SUBROUTINE body(VarIn,VarOut,s1,s2)
    1184         REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1185         REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1186         INTEGER,INTENT(IN) :: s1,s2
    1187        
    1188         REAL,DIMENSION(klon_glo,s1,s2) :: Var_tmp
    1189        
    1190         CALL gather_mpi(VarIn,Var_tmp)
    1191         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1192       END SUBROUTINE body
     785    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
     786
     787    CALL gather_mpi(VarIn,Var_tmp)
     788    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1193789
    1194790  END SUBROUTINE gather2D_mpi_r2
    … …  
    1201797    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1202798   
    1203     CALL body(VarIn,VarOut,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5))
    1204  
    1205     CONTAINS
    1206       SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1207         REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1208         REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1209         INTEGER,INTENT(IN) :: s1,s2,s3
    1210        
    1211         REAL,DIMENSION(klon_glo,s1,s2,s3) :: Var_tmp
    1212        
    1213         CALL gather_mpi(VarIn,Var_tmp)
    1214         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1215       END SUBROUTINE body
     799    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
     800   
     801    CALL gather_mpi(VarIn,Var_tmp)
     802    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1216803
    1217804  END SUBROUTINE gather2D_mpi_r3
    … …  
    1240827    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1241828   
    1242     CALL body(VarIn,VarOut,size(VarOut,3))
    1243  
    1244     CONTAINS
    1245       SUBROUTINE body(VarIn,VarOut,s1)
    1246         LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    1247         LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1248         INTEGER,INTENT(IN) :: s1
    1249        
    1250         LOGICAL,DIMENSION(klon_glo,s1) :: Var_tmp
    1251        
    1252         CALL gather_mpi(VarIn,Var_tmp)
    1253         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1254       END SUBROUTINE body
     829    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
     830
     831    CALL gather_mpi(VarIn,Var_tmp)
     832    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1255833
    1256834  END SUBROUTINE gather2D_mpi_l1
    … …  
    1263841    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1264842   
    1265     CALL body(VarIn,VarOut,size(VarOut,3),SIZE(VarOut,4))
    1266  
    1267     CONTAINS
    1268       SUBROUTINE body(VarIn,VarOut,s1,s2)
    1269         LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
    1270         LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1271         INTEGER,INTENT(IN) :: s1,s2
    1272        
    1273         LOGICAL,DIMENSION(klon_glo,s1,s2) :: Var_tmp
    1274        
    1275         CALL gather_mpi(VarIn,Var_tmp)
    1276         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1277       END SUBROUTINE body
     843    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
     844
     845    CALL gather_mpi(VarIn,Var_tmp)
     846    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1278847
    1279848  END SUBROUTINE gather2D_mpi_l2
    … …  
    1286855    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1287856   
    1288     CALL body(VarIn,VarOut,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5))
    1289  
    1290     CONTAINS
    1291       SUBROUTINE body(VarIn,VarOut,s1,s2,s3)
    1292         LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    1293         LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
    1294         INTEGER,INTENT(IN) :: s1,s2,s3
    1295        
    1296         LOGICAL,DIMENSION(klon_glo,s1,s2,s3) :: Var_tmp
    1297        
    1298         CALL gather_mpi(VarIn,Var_tmp)
    1299         CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1300       END SUBROUTINE body
     857    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
     858   
     859    CALL gather_mpi(VarIn,Var_tmp)
     860    CALL grid1dTo2d_glo(Var_tmp,VarOut)
    1301861
    1302862  END SUBROUTINE gather2D_mpi_l3
    … …  
    1313873    INTEGER,INTENT(IN)  :: VarIn
    1314874    INTEGER,INTENT(OUT) :: VarOut
    1315    
    1316     INTEGER :: dummy
    1317    
    1318 #ifndef CPP_PARA
    1319     VarOut=VarIn
    1320     RETURN
    1321 #endif
    1322 
    1323     IF (is_mpi_root) THEN
    1324       CALL reduce_sum_mpi_igen(VarIn,Varout,1)
    1325     ELSE
    1326       CALL reduce_sum_mpi_igen(VarIn,dummy,1)
    1327     ENDIF
    1328  
     875    INTEGER             :: VarIn_tmp(1)
     876    INTEGER             :: VarOut_tmp(1)
     877   
     878    VarIn_tmp(1)=VarIn   
     879    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
     880    VarOut=VarOut_tmp(1)
     881   
    1329882  END SUBROUTINE reduce_sum_mpi_i
    1330883
    … …  
    1336889    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    1337890   
    1338     INTEGER :: dummy
    1339    
    1340 #ifndef CPP_PARA
    1341     VarOut(:)=VarIn(:)
    1342     RETURN
    1343 #endif
    1344 
    1345     IF (is_mpi_root) THEN
    1346       CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1347     ELSE
    1348       CALL reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
    1349     ENDIF
     891    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1350892 
    1351893  END SUBROUTINE reduce_sum_mpi_i1
    … …  
    1358900    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    1359901   
    1360     INTEGER :: dummy
    1361    
    1362 #ifndef CPP_PARA
    1363     VarOut(:,:)=VarIn(:,:)
    1364     RETURN
    1365 #endif
    1366 
    1367     IF (is_mpi_root) THEN
    1368       CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1369     ELSE
    1370       CALL reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
    1371     ENDIF
     902    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1372903 
    1373904  END SUBROUTINE reduce_sum_mpi_i2
    … …  
    1380911    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1381912   
    1382     INTEGER :: dummy
    1383    
    1384 #ifndef CPP_PARA
    1385     VarOut(:,:,:)=VarIn(:,:,:)
    1386     RETURN
    1387 #endif
    1388 
    1389     IF (is_mpi_root) THEN
    1390       CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1391     ELSE
    1392       CALL reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
    1393     ENDIF
     913    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1394914 
    1395915  END SUBROUTINE reduce_sum_mpi_i3
    … …  
    1402922    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1403923   
    1404     INTEGER :: dummy
    1405    
    1406 #ifndef CPP_PARA
    1407     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    1408     RETURN
    1409 #endif
    1410 
    1411     IF (is_mpi_root) THEN
    1412       CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1413     ELSE
    1414       CALL reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))     
    1415     ENDIF
     924    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
    1416925 
    1417926  END SUBROUTINE reduce_sum_mpi_i4                 
    … …  
    1424933    REAL,INTENT(IN)  :: VarIn
    1425934    REAL,INTENT(OUT) :: VarOut
    1426    
    1427     REAL :: dummy
    1428    
    1429 #ifndef CPP_PARA
    1430     VarOut=VarIn
    1431     RETURN
    1432 #endif
    1433 
    1434     IF (is_mpi_root) THEN
    1435       CALL reduce_sum_mpi_rgen(VarIn,Varout,1)
    1436     ELSE
    1437       CALL reduce_sum_mpi_rgen(VarIn,dummy,1)
    1438     ENDIF
     935    REAL             :: VarIn_tmp(1)
     936    REAL             :: VarOut_tmp(1)
     937   
     938    VarIn_tmp(1)=VarIn   
     939    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
     940    VarOut=VarOut_tmp(1)
    1439941 
    1440942  END SUBROUTINE reduce_sum_mpi_r
    … …  
    1447949    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    1448950   
    1449     REAL :: dummy
    1450    
    1451 #ifndef CPP_PARA
    1452     VarOut(:)=VarIn(:)
    1453     RETURN
    1454 #endif
    1455 
    1456     IF (is_mpi_root) THEN
    1457       CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1458     ELSE
    1459       CALL reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
    1460     ENDIF
    1461  
     951    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
     952     
    1462953  END SUBROUTINE reduce_sum_mpi_r1
    1463954
    … …  
    1469960    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    1470961   
    1471     REAL :: dummy
    1472    
    1473 #ifndef CPP_PARA
    1474     VarOut(:,:)=VarIn(:,:)
    1475     RETURN
    1476 #endif
    1477 
    1478     IF (is_mpi_root) THEN
    1479       CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1480     ELSE
    1481       CALL reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
    1482     ENDIF
     962    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1483963 
    1484964  END SUBROUTINE reduce_sum_mpi_r2
    … …  
    1491971    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    1492972   
    1493     REAL :: dummy
    1494    
    1495 #ifndef CPP_PARA
    1496     VarOut(:,:,:)=VarIn(:,:,:)
    1497     RETURN
    1498 #endif
    1499 
    1500     IF (is_mpi_root) THEN
    1501       CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1502     ELSE
    1503       CALL reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
    1504     ENDIF
     973    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1505974 
    1506975  END SUBROUTINE reduce_sum_mpi_r3
    … …  
    1513982    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    1514983   
    1515     REAL :: dummy
    1516    
    1517 #ifndef CPP_PARA
    1518     VarOut(:,:,:,:)=VarIn(:,:,:,:)
    1519     RETURN
    1520 #endif
    1521 
    1522     IF (is_mpi_root) THEN
    1523       CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1524     ELSE
    1525       CALL reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))     
    1526     ENDIF
     984    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
    1527985 
    1528986  END SUBROUTINE reduce_sum_mpi_r4
    … …  
    17691227  END SUBROUTINE grid2dTo1d_mpi_l3
    17701228
    1771 
    1772                            
    1773 END MODULE mod_phys_lmdz_mpi_transfert
     1229               
     1230
    17741231
    17751232
    … …  
    17851242    INTEGER,INTENT(IN) :: nb
    17861243   
    1787 #ifdef CPP_PARA
     1244#ifdef CPP_MPI
    17881245    INCLUDE 'mpif.h'
    17891246#endif
    17901247    INTEGER :: ierr
    17911248
    1792     IF (.not.is_ok_mpi) RETURN
    1793    
    1794 #ifdef CPP_PARA
     1249    IF (.not.is_using_mpi) RETURN
     1250   
     1251#ifdef CPP_MPI
    17951252    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
    17961253#endif
    … …  
    18071264    INTEGER,INTENT(IN) :: nb
    18081265   
    1809 #ifdef CPP_PARA
     1266#ifdef CPP_MPI
    18101267    INCLUDE 'mpif.h'
    18111268#endif
    18121269    INTEGER :: ierr
    18131270
    1814     IF (.not.is_ok_mpi) RETURN
    1815 
    1816 #ifdef CPP_PARA
     1271    IF (.not.is_using_mpi) RETURN
     1272
     1273#ifdef CPP_MPI
    18171274    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
    18181275#endif
    … …  
    18301287    INTEGER,INTENT(IN) :: nb
    18311288   
    1832 #ifdef CPP_PARA
     1289#ifdef CPP_MPI
    18331290    INCLUDE 'mpif.h'
    18341291#endif
    18351292    INTEGER :: ierr
    18361293
    1837     IF (.not.is_ok_mpi) RETURN
    1838 
    1839 #ifdef CPP_PARA
     1294    IF (.not.is_using_mpi) RETURN
     1295
     1296#ifdef CPP_MPI
    18401297    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
    18411298#endif
    … …  
    18531310    INTEGER,INTENT(IN) :: nb
    18541311   
    1855 #ifdef CPP_PARA
     1312#ifdef CPP_MPI
    18561313    INCLUDE 'mpif.h'
    18571314#endif
    18581315    INTEGER :: ierr
    18591316
    1860     IF (.not.is_ok_mpi) RETURN
    1861 
    1862 #ifdef CPP_PARA
     1317    IF (.not.is_using_mpi) RETURN
     1318
     1319#ifdef CPP_MPI
    18631320    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
    18641321#endif
    … …  
    18771334    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
    18781335 
    1879 #ifdef CPP_PARA
     1336#ifdef CPP_MPI
    18801337    INCLUDE 'mpif.h'
    18811338#endif
    … …  
    18871344
    18881345
    1889     IF (.not.is_ok_mpi) THEN
     1346    IF (.not.is_using_mpi) THEN
    18901347      VarOut(:,:)=VarIn(:,:)
    18911348      RETURN
    … …  
    19061363    ENDIF
    19071364     
    1908 #ifdef CPP_PARA
     1365#ifdef CPP_MPI
    19091366    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
    19101367                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
    … …  
    19221379    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
    19231380 
    1924 #ifdef CPP_PARA
     1381#ifdef CPP_MPI
    19251382    INCLUDE 'mpif.h'
    19261383#endif
    … …  
    19321389    INTEGER :: ierr
    19331390
    1934     IF (.not.is_ok_mpi) THEN
     1391    IF (.not.is_using_mpi) THEN
    19351392      VarOut(:,:)=VarIn(:,:)
    19361393      RETURN
    … …  
    19501407    ENDIF
    19511408     
    1952 #ifdef CPP_PARA
     1409#ifdef CPP_MPI
    19531410    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
    19541411                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
    … …  
    19681425    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
    19691426 
    1970 #ifdef CPP_PARA
     1427#ifdef CPP_MPI
    19711428    INCLUDE 'mpif.h'
    19721429#endif
    … …  
    19781435    INTEGER :: ierr
    19791436
    1980     IF (.not.is_ok_mpi) THEN
     1437    IF (.not.is_using_mpi) THEN
    19811438      VarOut(:,:)=VarIn(:,:)
    19821439      RETURN
    … …  
    19961453    ENDIF
    19971454     
    1998 #ifdef CPP_PARA
     1455#ifdef CPP_MPI
    19991456    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
    20001457                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
    … …  
    20111468    IMPLICIT NONE
    20121469 
    2013 #ifdef CPP_PARA
     1470#ifdef CPP_MPI
    20141471    INCLUDE 'mpif.h'
    20151472#endif
    … …  
    20251482    INTEGER :: ierr
    20261483
    2027     IF (.not.is_ok_mpi) THEN
     1484    IF (.not.is_using_mpi) THEN
    20281485      VarOut(:,:)=VarIn(:,:)
    20291486      RETURN
    … …  
    20411498    ENDIF
    20421499   
    2043 #ifdef CPP_PARA
     1500#ifdef CPP_MPI
    20441501    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
    20451502                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
    … …  
    20651522    IMPLICIT NONE
    20661523 
    2067 #ifdef CPP_PARA
     1524#ifdef CPP_MPI
    20681525    INCLUDE 'mpif.h'
    20691526#endif
    … …  
    20891546    ENDIF
    20901547   
    2091     IF (.not.is_ok_mpi) THEN
     1548    IF (.not.is_using_mpi) THEN
    20921549      VarOut(:,:)=VarIn(:,:)
    20931550      RETURN
    20941551    ENDIF
    20951552
    2096 #ifdef CPP_PARA
     1553#ifdef CPP_MPI
    20971554    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
    20981555                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
    … …  
    21211578    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
    21221579 
    2123 #ifdef CPP_PARA
     1580#ifdef CPP_MPI
    21241581    INCLUDE 'mpif.h'
    21251582#endif
    … …  
    21311588    INTEGER :: ierr
    21321589   
    2133     IF (.not.is_ok_mpi) THEN
     1590    IF (.not.is_using_mpi) THEN
    21341591      VarOut(:,:)=VarIn(:,:)
    21351592      RETURN
    … …  
    21471604   
    21481605
    2149 #ifdef CPP_PARA
     1606#ifdef CPP_MPI
    21501607    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
    21511608                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
    … …  
    21721629    IMPLICIT NONE
    21731630   
    2174 #ifdef CPP_PARA
     1631#ifdef CPP_MPI
    21751632    INCLUDE 'mpif.h'
    21761633#endif
    … …  
    21811638    INTEGER :: ierr
    21821639   
    2183     IF (.not.is_ok_mpi) THEN
     1640    IF (.not.is_using_mpi) THEN
    21841641      VarOut(:)=VarIn(:)
    21851642      RETURN
    … …  
    21871644
    21881645
    2189 #ifdef CPP_PARA
     1646#ifdef CPP_MPI
    21901647    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
    21911648#endif
    … …  
    21991656    IMPLICIT NONE
    22001657
    2201 #ifdef CPP_PARA
     1658#ifdef CPP_MPI
    22021659    INCLUDE 'mpif.h'
    22031660#endif
    … …  
    22081665    INTEGER :: ierr
    22091666 
    2210     IF (.not.is_ok_mpi) THEN
     1667    IF (.not.is_using_mpi) THEN
    22111668      VarOut(:)=VarIn(:)
    22121669      RETURN
    22131670    ENDIF
    22141671   
    2215 #ifdef CPP_PARA
     1672#ifdef CPP_MPI
    22161673    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
    22171674#endif
    … …  
    24431900  END SUBROUTINE grid2dTo1d_mpi_lgen   
    24441901
     1902END MODULE mod_phys_lmdz_mpi_transfert

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_omp_data.F90

    r775 r1001  
    77  INTEGER,SAVE :: omp_rank
    88  LOGICAL,SAVE :: is_omp_root
    9   LOGICAL,SAVE :: is_ok_omp
     9  LOGICAL,SAVE :: is_using_omp
    1010 
    1111  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
    … …  
    2727    INTEGER :: i
    2828
    29 #ifdef _OPENMP   
     29#ifdef CPP_OMP   
    3030    INTEGER :: OMP_GET_NUM_THREADS
    3131    EXTERNAL OMP_GET_NUM_THREADS
    … …  
    3434#endif 
    3535
    36 #ifdef _OPENMP
     36#ifdef CPP_OMP
    3737!$OMP MASTER
    38         is_ok_omp=.TRUE.
     38        is_using_omp=.TRUE.
    3939        omp_size=OMP_GET_NUM_THREADS()
    4040!$OMP END MASTER
    4141        omp_rank=OMP_GET_THREAD_NUM()   
    4242#else   
    43     is_ok_omp=.FALSE.
     43    is_using_omp=.FALSE.
    4444    omp_size=1
    4545    omp_rank=0

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_omp_transfert.F90

    r775 r1001  
    44MODULE mod_phys_lmdz_omp_transfert
    55
    6   INTEGER,PARAMETER :: omp_buffer_size = 1024*1024*16
    7   INTEGER,SAVE,DIMENSION(omp_buffer_size) :: omp_buffer
     6  PRIVATE
     7 
     8  INTEGER,PARAMETER :: grow_factor=1.5
     9  INTEGER,PARAMETER :: size_min=1024
     10 
     11  CHARACTER(LEN=size_min),SAVE            :: buffer_c
     12  INTEGER,SAVE                            :: size_c
     13  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
     14  INTEGER,SAVE                            :: size_i
     15  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
     16  INTEGER,SAVE                            :: size_r
     17  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
     18  INTEGER,SAVE                            :: size_l
     19
     20
     21 
    822 
    923  INTERFACE bcast_omp
    … …  
    3347  END INTERFACE
    3448
     49
     50  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
     51
    3552CONTAINS
    3653
     54  SUBROUTINE check_buffer_i(buff_size)
     55  IMPLICIT NONE
     56  INTEGER :: buff_size
     57
     58    IF (buff_size>size_i) THEN
     59!$OMP BARRIER
     60!$OMP MASTER
     61      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
     62      size_i=MAX(size_min,INT(grow_factor*buff_size))
     63      ALLOCATE(buffer_i(size_i))
     64!$OMP END MASTER
     65!$OMP BARRIER
     66    ENDIF
     67 
     68  END SUBROUTINE check_buffer_i
     69 
     70  SUBROUTINE check_buffer_r(buff_size)
     71  IMPLICIT NONE
     72  INTEGER :: buff_size
     73
     74    IF (buff_size>size_r) THEN
     75!$OMP BARRIER
     76!$OMP MASTER
     77      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
     78      size_r=MAX(size_min,INT(grow_factor*buff_size))
     79      ALLOCATE(buffer_r(size_r))
     80!$OMP END MASTER
     81!$OMP BARRIER
     82    ENDIF
     83 
     84  END SUBROUTINE check_buffer_r
     85 
     86  SUBROUTINE check_buffer_l(buff_size)
     87  IMPLICIT NONE
     88  INTEGER :: buff_size
     89
     90    IF (buff_size>size_l) THEN
     91!$OMP BARRIER
     92!$OMP MASTER
     93      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
     94      size_l=MAX(size_min,INT(grow_factor*buff_size))
     95      ALLOCATE(buffer_l(size_l))
     96!$OMP END MASTER
     97!$OMP BARRIER
     98    ENDIF
     99 
     100  END SUBROUTINE check_buffer_l
     101   
    37102!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    38103!! Definition des Broadcast --> 4D   !!
    … …  
    44109  IMPLICIT NONE
    45110    CHARACTER(LEN=*),INTENT(INOUT) :: Var
    46 
    47     CALL bcast_omp_cgen(Var,len(Var),omp_buffer)
     111   
     112    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
    48113   
    49114  END SUBROUTINE bcast_omp_c
    … …  
    54119  IMPLICIT NONE
    55120    INTEGER,INTENT(INOUT) :: Var
    56 
    57     CALL bcast_omp_igen(Var,1,omp_buffer)
     121    INTEGER :: Var_tmp(1)
     122   
     123    Var_tmp(1)=Var
     124    CALL check_buffer_i(1)
     125    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
     126    Var=Var_tmp(1)
    58127
    59128  END SUBROUTINE bcast_omp_i
    … …  
    64133    INTEGER,INTENT(INOUT) :: Var(:)
    65134   
    66     CALL bcast_omp_igen(Var,size(Var),omp_buffer)
     135    CALL check_buffer_i(size(Var))
     136    CALL bcast_omp_igen(Var,size(Var),buffer_i)
    67137
    68138  END SUBROUTINE bcast_omp_i1
    … …  
    73143    INTEGER,INTENT(INOUT) :: Var(:,:)
    74144   
    75     CALL bcast_omp_igen(Var,size(Var),omp_buffer)
     145    CALL check_buffer_i(size(Var))
     146    CALL bcast_omp_igen(Var,size(Var),buffer_i)
    76147
    77148  END SUBROUTINE bcast_omp_i2
    … …  
    82153    INTEGER,INTENT(INOUT) :: Var(:,:,:)
    83154
    84     CALL bcast_omp_igen(Var,size(Var),omp_buffer)
     155    CALL check_buffer_i(size(Var))
     156    CALL bcast_omp_igen(Var,size(Var),buffer_i)
    85157
    86158  END SUBROUTINE bcast_omp_i3
    … …  
    91163    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
    92164   
    93     CALL bcast_omp_igen(Var,size(Var),omp_buffer)
     165    CALL check_buffer_i(size(Var))
     166    CALL bcast_omp_igen(Var,size(Var),buffer_i)
    94167
    95168  END SUBROUTINE bcast_omp_i4
    … …  
    101174  IMPLICIT NONE
    102175    REAL,INTENT(INOUT) :: Var
    103 
    104     CALL bcast_omp_rgen(Var,1,omp_buffer)
     176    REAL :: Var_tmp(1)
     177   
     178    Var_tmp(1)=Var
     179    CALL check_buffer_r(1)
     180    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
     181    Var=Var_tmp(1)
    105182
    106183  END SUBROUTINE bcast_omp_r
    … …  
    111188    REAL,INTENT(INOUT) :: Var(:)
    112189   
    113     CALL bcast_omp_rgen(Var,size(Var),omp_buffer)
     190    CALL check_buffer_r(size(Var))
     191    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
    114192
    115193  END SUBROUTINE bcast_omp_r1
    … …  
    120198    REAL,INTENT(INOUT) :: Var(:,:)
    121199   
    122     CALL bcast_omp_rgen(Var,size(Var),omp_buffer)
     200    CALL check_buffer_r(size(Var))
     201    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
    123202
    124203  END SUBROUTINE bcast_omp_r2
    … …  
    129208    REAL,INTENT(INOUT) :: Var(:,:,:)
    130209
    131     CALL bcast_omp_igen(Var,size(Var),omp_buffer)
     210    CALL check_buffer_r(size(Var))
     211    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
    132212
    133213  END SUBROUTINE bcast_omp_r3
    … …  
    138218    REAL,INTENT(INOUT) :: Var(:,:,:,:)
    139219   
    140     CALL bcast_omp_rgen(Var,size(Var),omp_buffer)
     220    CALL check_buffer_r(size(Var))
     221    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
    141222
    142223  END SUBROUTINE bcast_omp_r4
    … …  
    148229  IMPLICIT NONE
    149230    LOGICAL,INTENT(INOUT) :: Var
    150 
    151     CALL bcast_omp_lgen(Var,1,omp_buffer)
     231    LOGICAL :: Var_tmp(1)
     232   
     233    Var_tmp(1)=Var
     234    CALL check_buffer_l(1)
     235    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
     236    Var=Var_tmp(1)
    152237
    153238  END SUBROUTINE bcast_omp_l
    … …  
    158243    LOGICAL,INTENT(INOUT) :: Var(:)
    159244   
    160     CALL bcast_omp_lgen(Var,size(Var),omp_buffer)
     245    CALL check_buffer_l(size(Var))
     246    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
    161247
    162248  END SUBROUTINE bcast_omp_l1
    … …  
    167253    LOGICAL,INTENT(INOUT) :: Var(:,:)
    168254   
    169     CALL bcast_omp_lgen(Var,size(Var),omp_buffer)
     255    CALL check_buffer_l(size(Var))
     256    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
    170257
    171258  END SUBROUTINE bcast_omp_l2
    … …  
    176263    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
    177264
    178     CALL bcast_omp_lgen(Var,size(Var),omp_buffer)
     265    CALL check_buffer_l(size(Var))
     266    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
    179267
    180268  END SUBROUTINE bcast_omp_l3
    … …  
    185273    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
    186274   
    187     CALL bcast_omp_lgen(Var,size(Var),omp_buffer)
     275    CALL check_buffer_l(size(Var))
     276    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
    188277
    189278  END SUBROUTINE bcast_omp_l4
    … …  
    196285
    197286  SUBROUTINE scatter_omp_i(VarIn, VarOut)
    198     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    199287    IMPLICIT NONE
    200288 
    … …  
    202290    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    203291
    204     INTEGER :: dummy
    205 
    206 
    207      IF (is_omp_root) THEN
    208       CALL scatter_omp_igen(VarIn,Varout,1,omp_buffer)
    209      ELSE
    210       CALL scatter_omp_igen(dummy,Varout,1,omp_buffer)
    211     ENDIF
     292    CALL Check_buffer_i(size(VarIn))   
     293    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
    212294   
    213295  END SUBROUTINE scatter_omp_i
    … …  
    215297
    216298  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
    217     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    218299    IMPLICIT NONE
    219300 
    220301    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
    221302    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    222    
    223     INTEGER :: dummy
    224 
    225     IF (is_omp_root) THEN
    226       CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),omp_buffer)
    227     ELSE
    228       CALL scatter_omp_igen(dummy,Varout,Size(VarOut,2),omp_buffer)
    229     ENDIF
     303
     304    CALL Check_buffer_i(size(VarIn))   
     305    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
    230306   
    231307  END SUBROUTINE scatter_omp_i1
    … …  
    233309 
    234310  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
    235     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    236311    IMPLICIT NONE
    237312 
    … …  
    239314    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    240315   
    241     INTEGER :: dummy
    242    
    243     IF (is_omp_root) THEN
    244       CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
    245     ELSE
    246       CALL scatter_omp_igen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
    247     ENDIF
     316    CALL Check_buffer_i(size(VarIn))   
     317    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
    248318
    249319  END SUBROUTINE scatter_omp_i2
    … …  
    251321
    252322  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
    253     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    254323    IMPLICIT NONE
    255324 
    … …  
    257326    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    258327   
    259     INTEGER :: dummy
    260    
    261     IF (is_omp_root) THEN
    262       CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
    263     ELSE
    264       CALL scatter_omp_igen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
    265     ENDIF
     328    CALL Check_buffer_i(size(VarIn))   
     329    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
    266330 
    267331  END SUBROUTINE scatter_omp_i3
    … …  
    271335
    272336  SUBROUTINE scatter_omp_r(VarIn, VarOut)
    273     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    274337    IMPLICIT NONE
    275338 
    … …  
    277340    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    278341
    279     REAL :: dummy
    280 
    281 
    282      IF (is_omp_root) THEN
    283       CALL scatter_omp_rgen(VarIn,Varout,1,omp_buffer)
    284      ELSE
    285       CALL scatter_omp_rgen(dummy,Varout,1,omp_buffer)
    286     ENDIF
     342    CALL Check_buffer_r(size(VarIn))   
     343    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
    287344   
    288345  END SUBROUTINE scatter_omp_r
    … …  
    290347
    291348  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
    292     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    293349    IMPLICIT NONE
    294350 
    … …  
    296352    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    297353   
    298     REAL :: dummy
    299 
    300     IF (is_omp_root) THEN
    301       CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),omp_buffer)
    302     ELSE
    303       CALL scatter_omp_rgen(dummy,Varout,Size(VarOut,2),omp_buffer)
    304     ENDIF
    305    
     354    CALL Check_buffer_r(size(VarIn))   
     355    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
     356       
    306357  END SUBROUTINE scatter_omp_r1
    307358 
    308359 
    309360  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
    310     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    311361    IMPLICIT NONE
    312362 
    … …  
    314364    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    315365   
    316     REAL :: dummy
    317    
    318     IF (is_omp_root) THEN
    319       CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
    320     ELSE
    321       CALL scatter_omp_rgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
    322     ENDIF
     366    CALL Check_buffer_r(size(VarIn))   
     367    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
    323368
    324369  END SUBROUTINE scatter_omp_r2
    … …  
    326371
    327372  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
    328     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    329373    IMPLICIT NONE
    330374 
    … …  
    332376    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    333377   
    334     REAL :: dummy
    335    
    336     IF (is_omp_root) THEN
    337       CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
    338     ELSE
    339       CALL scatter_omp_rgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
    340     ENDIF
     378    CALL Check_buffer_r(size(VarIn))   
     379    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
    341380 
    342381  END SUBROUTINE scatter_omp_r3
    … …  
    345384
    346385  SUBROUTINE scatter_omp_l(VarIn, VarOut)
    347     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    348386    IMPLICIT NONE
    349387 
    … …  
    351389    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
    352390
    353     LOGICAL :: dummy
    354 
    355 
    356      IF (is_omp_root) THEN
    357       CALL scatter_omp_lgen(VarIn,Varout,1,omp_buffer)
    358      ELSE
    359       CALL scatter_omp_lgen(dummy,Varout,1,omp_buffer)
    360     ENDIF
     391    CALL Check_buffer_l(size(VarIn))   
     392    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
    361393   
    362394  END SUBROUTINE scatter_omp_l
    … …  
    364396
    365397  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
    366     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    367398    IMPLICIT NONE
    368399 
    … …  
    370401    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    371402   
    372     LOGICAL :: dummy
    373 
    374     IF (is_omp_root) THEN
    375       CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),omp_buffer)
    376     ELSE
    377       CALL scatter_omp_lgen(dummy,Varout,Size(VarOut,2),omp_buffer)
    378     ENDIF
     403    CALL Check_buffer_l(size(VarIn))   
     404    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
    379405   
    380406  END SUBROUTINE scatter_omp_l1
    … …  
    382408 
    383409  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
    384     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    385410    IMPLICIT NONE
    386411 
    … …  
    388413    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    389414   
    390     LOGICAL :: dummy
    391    
    392     IF (is_omp_root) THEN
    393       CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
    394     ELSE
    395       CALL scatter_omp_lgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3),omp_buffer)
    396     ENDIF
     415    CALL Check_buffer_l(size(VarIn))   
     416    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
    397417
    398418  END SUBROUTINE scatter_omp_l2
    … …  
    400420
    401421  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
    402     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    403422    IMPLICIT NONE
    404423 
    … …  
    406425    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    407426   
    408     LOGICAL :: dummy
    409    
    410     IF (is_omp_root) THEN
    411       CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
    412     ELSE
    413       CALL scatter_omp_lgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),omp_buffer)
    414     ENDIF
     427    CALL Check_buffer_l(size(VarIn))   
     428    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
    415429 
    416430  END SUBROUTINE scatter_omp_l3 
    … …  
    418432
    419433  SUBROUTINE gather_omp_i(VarIn, VarOut)
    420     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    421434    IMPLICIT NONE
    422435 
    … …  
    424437    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    425438
    426     INTEGER :: dummy
    427 
    428 
    429      IF (is_omp_root) THEN
    430       CALL gather_omp_igen(VarIn,Varout,1,omp_buffer)
    431      ELSE
    432       CALL gather_omp_igen(dummy,Varout,1,omp_buffer)
    433     ENDIF
     439    CALL Check_buffer_i(size(VarOut))   
     440    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
    434441   
    435442  END SUBROUTINE gather_omp_i
    … …  
    437444
    438445  SUBROUTINE gather_omp_i1(VarIn, VarOut)
    439     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    440446    IMPLICIT NONE
    441447 
    … …  
    443449    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    444450   
    445     INTEGER :: dummy
    446 
    447     IF (is_omp_root) THEN
    448       CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),omp_buffer)
    449     ELSE
    450       CALL gather_omp_igen(VarIn,dummy,Size(VarIn,2),omp_buffer)
    451     ENDIF
     451    CALL Check_buffer_i(size(VarOut))   
     452    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
    452453   
    453454  END SUBROUTINE gather_omp_i1
    … …  
    455456
    456457  SUBROUTINE gather_omp_i2(VarIn, VarOut)
    457     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    458458    IMPLICIT NONE
    459459 
    … …  
    461461    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    462462   
    463     INTEGER :: dummy
    464 
    465     IF (is_omp_root) THEN
    466       CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
    467     ELSE
    468       CALL gather_omp_igen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
    469     ENDIF
    470    
     463    CALL Check_buffer_i(size(VarOut))   
     464    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
     465         
    471466  END SUBROUTINE gather_omp_i2
    472467 
    473468
    474469  SUBROUTINE gather_omp_i3(VarIn, VarOut)
    475     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    476470    IMPLICIT NONE
    477471 
    … …  
    479473    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    480474   
    481     INTEGER :: dummy
    482 
    483     IF (is_omp_root) THEN
    484       CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
    485     ELSE
    486       CALL gather_omp_igen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
    487     ENDIF
     475    CALL Check_buffer_i(size(VarOut))   
     476    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
    488477   
    489478  END SUBROUTINE gather_omp_i3
    … …  
    492481
    493482  SUBROUTINE gather_omp_r(VarIn, VarOut)
    494     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    495483    IMPLICIT NONE
    496484 
    … …  
    498486    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    499487
    500     REAL :: dummy
    501 
    502 
    503      IF (is_omp_root) THEN
    504       CALL gather_omp_rgen(VarIn,Varout,1,omp_buffer)
    505      ELSE
    506       CALL gather_omp_rgen(VarIn,dummy,1,omp_buffer)
    507     ENDIF
     488    CALL Check_buffer_r(size(VarOut))   
     489    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
    508490   
    509491  END SUBROUTINE gather_omp_r
    … …  
    511493
    512494  SUBROUTINE gather_omp_r1(VarIn, VarOut)
    513     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    514495    IMPLICIT NONE
    515496 
    516497    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
    517498    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    518    
    519     REAL :: dummy
    520 
    521     IF (is_omp_root) THEN
    522       CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),omp_buffer)
    523     ELSE
    524       CALL gather_omp_rgen(VarIn,dummy,Size(VarIn,2),omp_buffer)
    525     ENDIF
    526    
     499
     500    CALL Check_buffer_r(size(VarOut))   
     501    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
     502       
    527503  END SUBROUTINE gather_omp_r1
    528504
    529505
    530506  SUBROUTINE gather_omp_r2(VarIn, VarOut)
    531     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    532507    IMPLICIT NONE
    533508 
    … …  
    535510    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    536511   
    537     REAL :: dummy
    538 
    539     IF (is_omp_root) THEN
    540       CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
    541     ELSE
    542       CALL gather_omp_rgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
    543     ENDIF
     512    CALL Check_buffer_r(size(VarOut))   
     513    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
    544514   
    545515  END SUBROUTINE gather_omp_r2
    … …  
    547517
    548518  SUBROUTINE gather_omp_r3(VarIn, VarOut)
    549     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    550519    IMPLICIT NONE
    551520 
    … …  
    553522    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    554523   
    555     REAL :: dummy
    556 
    557     IF (is_omp_root) THEN
    558       CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
    559     ELSE
    560       CALL gather_omp_rgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
    561     ENDIF
     524    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
    562525   
    563526  END SUBROUTINE gather_omp_r3
    … …  
    565528
    566529  SUBROUTINE gather_omp_l(VarIn, VarOut)
    567     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    568530    IMPLICIT NONE
    569531 
    … …  
    571533    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
    572534
    573     LOGICAL :: dummy
    574 
    575 
    576      IF (is_omp_root) THEN
    577       CALL gather_omp_lgen(VarIn,Varout,1,omp_buffer)
    578      ELSE
    579       CALL gather_omp_lgen(VarIn,dummy,1,omp_buffer)
    580     ENDIF
     535    CALL Check_buffer_l(size(VarOut))   
     536    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
    581537   
    582538  END SUBROUTINE gather_omp_l
    … …  
    584540
    585541  SUBROUTINE gather_omp_l1(VarIn, VarOut)
    586     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    587542    IMPLICIT NONE
    588543 
    … …  
    590545    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    591546   
    592     LOGICAL :: dummy
    593 
    594     IF (is_omp_root) THEN
    595       CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),omp_buffer)
    596     ELSE
    597       CALL gather_omp_lgen(VarIn,dummy,Size(VarIn,2),omp_buffer)
    598     ENDIF
     547    CALL Check_buffer_l(size(VarOut))   
     548    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
    599549   
    600550  END SUBROUTINE gather_omp_l1
    … …  
    602552
    603553  SUBROUTINE gather_omp_l2(VarIn, VarOut)
    604     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    605554    IMPLICIT NONE
    606555 
    … …  
    608557    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    609558   
    610     LOGICAL :: dummy
    611 
    612     IF (is_omp_root) THEN
    613       CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
    614     ELSE
    615       CALL gather_omp_lgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3),omp_buffer)
    616     ENDIF
     559    CALL Check_buffer_l(size(VarOut))   
     560    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
    617561   
    618562  END SUBROUTINE gather_omp_l2
    … …  
    620564
    621565  SUBROUTINE gather_omp_l3(VarIn, VarOut)
    622     USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
    623566    IMPLICIT NONE
    624567 
    … …  
    626569    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    627570   
    628     LOGICAL :: dummy
    629 
    630     IF (is_omp_root) THEN
    631       CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
    632     ELSE
    633       CALL gather_omp_lgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),omp_buffer)
    634     ENDIF
     571    CALL Check_buffer_l(size(VarOut))   
     572    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
    635573   
    636574  END SUBROUTINE gather_omp_l3
    … …  
    644582    INTEGER,INTENT(IN)  :: VarIn
    645583    INTEGER,INTENT(OUT) :: VarOut
    646    
    647     CALL reduce_sum_omp_igen(VarIn,Varout,1,omp_buffer)
    648  
     584    INTEGER             :: VarIn_tmp(1)
     585    INTEGER             :: VarOut_tmp(1)
     586   
     587    VarIn_tmp(1)=VarIn
     588    CALL Check_buffer_i(1)   
     589    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
     590    VarOut=VarOut_tmp(1)
     591   
    649592  END SUBROUTINE reduce_sum_omp_i
    650593
    … …  
    655598    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
    656599   
    657     CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),omp_buffer)
     600    CALL Check_buffer_i(size(VarIn))   
     601    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
    658602   
    659603  END SUBROUTINE reduce_sum_omp_i1
    … …  
    665609    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
    666610    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
    667    
    668     CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),omp_buffer)
     611
     612    CALL Check_buffer_i(size(VarIn))   
     613    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
    669614 
    670615  END SUBROUTINE reduce_sum_omp_i2
    … …  
    677622    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    678623   
    679     CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),omp_buffer)
     624    CALL Check_buffer_i(size(VarIn))   
     625    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
    680626 
    681627  END SUBROUTINE reduce_sum_omp_i3
    … …  
    688634    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    689635 
    690     CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),omp_buffer)
     636    CALL Check_buffer_i(size(VarIn))   
     637    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
    691638 
    692639  END SUBROUTINE reduce_sum_omp_i4
    … …  
    698645    REAL,INTENT(IN)  :: VarIn
    699646    REAL,INTENT(OUT) :: VarOut
    700    
    701     CALL reduce_sum_omp_rgen(VarIn,Varout,1,omp_buffer)
     647    REAL             :: VarIn_tmp(1)
     648    REAL             :: VarOut_tmp(1)
     649   
     650    VarIn_tmp(1)=VarIn
     651    CALL Check_buffer_r(1)   
     652    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
     653    VarOut=VarOut_tmp(1)
    702654 
    703655  END SUBROUTINE reduce_sum_omp_r
    … …  
    709661    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
    710662   
    711     CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),omp_buffer)
     663    CALL Check_buffer_r(size(VarIn))   
     664    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
    712665   
    713666  END SUBROUTINE reduce_sum_omp_r1
    … …  
    720673    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
    721674   
    722     CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),omp_buffer)
     675    CALL Check_buffer_r(size(VarIn))   
     676    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
    723677 
    724678  END SUBROUTINE reduce_sum_omp_r2
    … …  
    731685    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
    732686   
    733     CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),omp_buffer)
     687    CALL Check_buffer_r(size(VarIn))   
     688    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
    734689 
    735690  END SUBROUTINE reduce_sum_omp_r3
    … …  
    742697    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    743698 
    744     CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),omp_buffer)
     699    CALL Check_buffer_r(size(VarIn))   
     700    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
    745701 
    746702  END SUBROUTINE reduce_sum_omp_r4
    747703
    748 
    749 
    750 END MODULE mod_phys_lmdz_omp_transfert
    751 
    752 
    753 
    754 
    755 
    756 SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
    757   IMPLICIT NONE
    758    
    759   CHARACTER(LEN=*),INTENT(INOUT) :: Var
    760   CHARACTER(LEN=*),INTENT(INOUT) :: Buff
    761   INTEGER,INTENT(IN) :: Nb
    762    
    763   INTEGER :: i
    764  
    765 !$OMP MASTER
    766     Buff=Var
    767 !$OMP END MASTER
    768 !$OMP BARRIER
    769 
    770   DO i=1,Nb
    771     Var=Buff
    772   ENDDO
    773 !$OMP BARRIER     
    774  
    775 END SUBROUTINE bcast_omp_cgen
     704!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     705!    LES ROUTINES GENERIQUES    !
     706!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     707
     708  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
     709  IMPLICIT NONE
     710   
     711    CHARACTER(LEN=*),INTENT(INOUT) :: Var
     712    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
     713    INTEGER,INTENT(IN) :: Nb
     714   
     715    INTEGER :: i
     716 
     717  !$OMP MASTER
     718      Buff=Var
     719  !$OMP END MASTER
     720  !$OMP BARRIER
     721
     722    DO i=1,Nb
     723      Var=Buff
     724    ENDDO
     725  !$OMP BARRIER     
     726 
     727  END SUBROUTINE bcast_omp_cgen
    776728
    777729
    778730     
    779 SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
    780   IMPLICIT NONE
    781    
    782   INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
    783   INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
    784   INTEGER,INTENT(IN) :: Nb
    785 
    786   INTEGER :: i
    787    
    788 !$OMP MASTER
    789   DO i=1,Nb
    790     Buff(i)=Var(i)
    791   ENDDO
    792 !$OMP END MASTER
    793 !$OMP BARRIER
    794 
    795   DO i=1,Nb
    796     Var(i)=Buff(i)
    797   ENDDO
    798 !$OMP BARRIER       
    799 
    800 END SUBROUTINE bcast_omp_igen
    801 
    802 
    803 SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
    804   IMPLICIT NONE
    805    
    806   REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
    807   REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
    808   INTEGER,INTENT(IN) :: Nb
    809 
    810   INTEGER :: i
    811    
    812 !$OMP MASTER
    813   DO i=1,Nb
    814     Buff(i)=Var(i)
    815   ENDDO
    816 !$OMP END MASTER
    817 !$OMP BARRIER
    818 
    819   DO i=1,Nb
    820     Var(i)=Buff(i)
    821   ENDDO
    822 !$OMP BARRIER       
    823 
    824 END SUBROUTINE bcast_omp_rgen
    825 
    826 SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
    827   IMPLICIT NONE
    828    
    829   LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
    830   LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
    831   INTEGER,INTENT(IN) :: Nb
    832 
    833   INTEGER :: i
    834    
    835 !$OMP MASTER
    836   DO i=1,Nb
    837     Buff(i)=Var(i)
    838   ENDDO
    839 !$OMP END MASTER
    840 !$OMP BARRIER
    841 
    842   DO i=1,Nb
    843     Var(i)=Buff(i)
    844   ENDDO
    845 !$OMP BARRIER       
    846 
    847 END SUBROUTINE bcast_omp_lgen
    848 
    849 
    850 
    851 
    852 
    853 SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
     731  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
     732  IMPLICIT NONE
     733   
     734    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
     735    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
     736    INTEGER,INTENT(IN) :: Nb
     737
     738    INTEGER :: i
     739   
     740  !$OMP MASTER
     741    DO i=1,Nb
     742      Buff(i)=Var(i)
     743    ENDDO
     744  !$OMP END MASTER
     745  !$OMP BARRIER
     746
     747    DO i=1,Nb
     748      Var(i)=Buff(i)
     749    ENDDO
     750  !$OMP BARRIER       
     751
     752  END SUBROUTINE bcast_omp_igen
     753
     754
     755  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
     756  IMPLICIT NONE
     757   
     758    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
     759    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
     760    INTEGER,INTENT(IN) :: Nb
     761
     762    INTEGER :: i
     763   
     764  !$OMP MASTER
     765    DO i=1,Nb
     766      Buff(i)=Var(i)
     767    ENDDO
     768  !$OMP END MASTER
     769  !$OMP BARRIER
     770
     771    DO i=1,Nb
     772      Var(i)=Buff(i)
     773    ENDDO
     774  !$OMP BARRIER       
     775
     776  END SUBROUTINE bcast_omp_rgen
     777
     778  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
     779  IMPLICIT NONE
     780   
     781    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
     782    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
     783    INTEGER,INTENT(IN) :: Nb
     784 
     785    INTEGER :: i
     786   
     787  !$OMP MASTER
     788    DO i=1,Nb
     789      Buff(i)=Var(i)
     790    ENDDO
     791  !$OMP END MASTER
     792  !$OMP BARRIER
     793
     794    DO i=1,Nb
     795      Var(i)=Buff(i)
     796    ENDDO
     797  !$OMP BARRIER       
     798
     799  END SUBROUTINE bcast_omp_lgen
     800
     801
     802  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
     803    USE mod_phys_lmdz_omp_data
     804    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
     805    IMPLICIT NONE
     806
     807    INTEGER,INTENT(IN) :: dimsize
     808    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
     809    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
     810    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
     811
     812    INTEGER :: i,ij
     813   
     814  !$OMP MASTER
     815    DO i=1,dimsize
     816      DO ij=1,klon_mpi
     817        Buff(ij,i)=VarIn(ij,i)
     818      ENDDO
     819    ENDDO 
     820  !$OMP END MASTER
     821  !$OMP BARRIER
     822 
     823    DO i=1,dimsize
     824      DO ij=1,klon_omp
     825        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
     826      ENDDO
     827    ENDDO
     828  !$OMP BARRIER 
     829 
     830  END SUBROUTINE scatter_omp_igen
     831
     832
     833  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
    854834  USE mod_phys_lmdz_omp_data
    855835  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    856836  IMPLICIT NONE
    857837
    858   INTEGER,INTENT(IN) :: dimsize
    859   INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
    860   INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
    861   INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
    862 
    863   INTEGER :: i,ij
    864    
    865 !$OMP MASTER
    866   DO i=1,dimsize
    867     DO ij=1,klon_mpi
    868       Buff(ij,i)=VarIn(ij,i)
    869     ENDDO
    870   ENDDO 
    871 !$OMP END MASTER
    872 !$OMP BARRIER
    873 
    874   DO i=1,dimsize
    875     DO ij=1,klon_omp
    876       VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
    877     ENDDO
    878   ENDDO
    879 !$OMP BARRIER 
    880 
    881 END SUBROUTINE scatter_omp_igen
    882 
    883 
    884 SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
     838    INTEGER,INTENT(IN) :: dimsize
     839    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
     840    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
     841    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
     842
     843    INTEGER :: i,ij
     844   
     845  !$OMP MASTER
     846    DO i=1,dimsize
     847      DO ij=1,klon_mpi
     848        Buff(ij,i)=VarIn(ij,i)
     849      ENDDO
     850    ENDDO 
     851  !$OMP END MASTER
     852  !$OMP BARRIER
     853
     854    DO i=1,dimsize
     855      DO ij=1,klon_omp
     856        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
     857      ENDDO
     858    ENDDO
     859  !$OMP BARRIER 
     860
     861  END SUBROUTINE scatter_omp_rgen
     862
     863
     864  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
    885865  USE mod_phys_lmdz_omp_data
    886866  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    887867  IMPLICIT NONE
    888868
    889   INTEGER,INTENT(IN) :: dimsize
    890   REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
    891   REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
    892   REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
    893 
    894   INTEGER :: i,ij
    895    
    896 !$OMP MASTER
    897   DO i=1,dimsize
    898     DO ij=1,klon_mpi
    899       Buff(ij,i)=VarIn(ij,i)
    900     ENDDO
    901   ENDDO 
    902 !$OMP END MASTER
    903 !$OMP BARRIER
    904 
    905   DO i=1,dimsize
    906     DO ij=1,klon_omp
    907       VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
    908     ENDDO
    909   ENDDO
    910 !$OMP BARRIER 
    911 
    912 END SUBROUTINE scatter_omp_rgen
    913 
    914 
    915 SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
     869    INTEGER,INTENT(IN) :: dimsize
     870    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
     871    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
     872    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
     873
     874    INTEGER :: i,ij
     875   
     876 !$OMP MASTER
     877    DO i=1,dimsize
     878      DO ij=1,klon_mpi
     879        Buff(ij,i)=VarIn(ij,i)
     880      ENDDO
     881    ENDDO 
     882  !$OMP END MASTER
     883  !$OMP BARRIER
     884
     885    DO i=1,dimsize
     886      DO ij=1,klon_omp
     887        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
     888      ENDDO
     889    ENDDO
     890  !$OMP BARRIER 
     891
     892  END SUBROUTINE scatter_omp_lgen
     893
     894
     895
     896
     897
     898  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
    916899  USE mod_phys_lmdz_omp_data
    917900  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    918901  IMPLICIT NONE
    919902
    920   INTEGER,INTENT(IN) :: dimsize
    921   LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
    922   LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
    923   LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
    924 
    925   INTEGER :: i,ij
    926    
    927 !$OMP MASTER
    928   DO i=1,dimsize
    929     DO ij=1,klon_mpi
    930       Buff(ij,i)=VarIn(ij,i)
    931     ENDDO
    932   ENDDO 
    933 !$OMP END MASTER
    934 !$OMP BARRIER
    935 
    936   DO i=1,dimsize
    937     DO ij=1,klon_omp
    938       VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
    939     ENDDO
    940   ENDDO
    941 !$OMP BARRIER 
    942 
    943 END SUBROUTINE scatter_omp_lgen
    944 
    945 
    946 
    947 
    948 
    949 SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
     903    INTEGER,INTENT(IN) :: dimsize
     904    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
     905    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
     906    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
     907
     908    INTEGER :: i,ij
     909   
     910    DO i=1,dimsize
     911      DO ij=1,klon_omp
     912        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
     913      ENDDO
     914    ENDDO
     915  !$OMP BARRIER 
     916 
     917 
     918  !$OMP MASTER
     919    DO i=1,dimsize
     920      DO ij=1,klon_mpi
     921        VarOut(ij,i)=Buff(ij,i)
     922      ENDDO
     923    ENDDO 
     924  !$OMP END MASTER
     925  !$OMP BARRIER
     926
     927  END SUBROUTINE gather_omp_igen
     928
     929
     930  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
    950931  USE mod_phys_lmdz_omp_data
    951932  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    952933  IMPLICIT NONE
    953934
    954   INTEGER,INTENT(IN) :: dimsize
    955   INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
    956   INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
    957   INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
    958 
    959   INTEGER :: i,ij
    960    
    961   DO i=1,dimsize
    962     DO ij=1,klon_omp
    963       Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
    964     ENDDO
    965   ENDDO
    966 !$OMP BARRIER 
    967 
    968 
    969 !$OMP MASTER
    970   DO i=1,dimsize
    971     DO ij=1,klon_mpi
    972       VarOut(ij,i)=Buff(ij,i)
    973     ENDDO
    974   ENDDO 
    975 !$OMP END MASTER
    976 !$OMP BARRIER
    977 
    978 END SUBROUTINE gather_omp_igen
    979 
    980 
    981 SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
     935    INTEGER,INTENT(IN) :: dimsize
     936    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
     937    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
     938    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
     939
     940    INTEGER :: i,ij
     941   
     942    DO i=1,dimsize
     943      DO ij=1,klon_omp
     944        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
     945      ENDDO
     946    ENDDO
     947  !$OMP BARRIER 
     948
     949
     950  !$OMP MASTER
     951    DO i=1,dimsize
     952      DO ij=1,klon_mpi
     953        VarOut(ij,i)=Buff(ij,i)
     954      ENDDO
     955    ENDDO 
     956  !$OMP END MASTER
     957  !$OMP BARRIER
     958
     959  END SUBROUTINE gather_omp_rgen
     960
     961
     962  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
    982963  USE mod_phys_lmdz_omp_data
    983964  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    984965  IMPLICIT NONE
    985966
    986   INTEGER,INTENT(IN) :: dimsize
    987   REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
    988   REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
    989   REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
    990 
    991   INTEGER :: i,ij
    992    
    993   DO i=1,dimsize
    994     DO ij=1,klon_omp
    995       Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
    996     ENDDO
    997   ENDDO
    998 !$OMP BARRIER 
    999 
    1000 
    1001 !$OMP MASTER
    1002   DO i=1,dimsize
    1003     DO ij=1,klon_mpi
    1004       VarOut(ij,i)=Buff(ij,i)
    1005     ENDDO
    1006   ENDDO 
    1007 !$OMP END MASTER
    1008 !$OMP BARRIER
    1009 
    1010 END SUBROUTINE gather_omp_rgen
    1011 
    1012 
    1013 SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
    1014   USE mod_phys_lmdz_omp_data
    1015   USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
    1016   IMPLICIT NONE
    1017 
    1018   INTEGER,INTENT(IN) :: dimsize
    1019   LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
    1020   LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
    1021   LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
    1022 
    1023   INTEGER :: i,ij
    1024    
    1025   DO i=1,dimsize
    1026     DO ij=1,klon_omp
    1027       Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
    1028     ENDDO
    1029   ENDDO
    1030 !$OMP BARRIER 
    1031 
    1032 
    1033 !$OMP MASTER
    1034   DO i=1,dimsize
    1035     DO ij=1,klon_mpi
    1036       VarOut(ij,i)=Buff(ij,i)
    1037     ENDDO
    1038   ENDDO 
    1039 !$OMP END MASTER
    1040 !$OMP BARRIER
    1041 
    1042 END SUBROUTINE gather_omp_lgen
    1043 
    1044 
    1045 SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
    1046   IMPLICIT NONE
    1047 
    1048   INTEGER,INTENT(IN) :: dimsize
    1049   INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
    1050   INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
    1051   INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
    1052 
    1053   INTEGER :: i
    1054 
    1055 !$OMP MASTER
    1056   Buff(:)=0
    1057 !$OMP END MASTER
    1058 !$OMP BARRIER
    1059 
    1060 !$OMP CRITICAL     
    1061   DO i=1,dimsize
    1062     Buff(i)=Buff(i)+VarIn(i)
    1063   ENDDO
    1064 !$OMP END CRITICAL
    1065 !$OMP BARRIER 
    1066 
    1067 !$OMP MASTER
    1068   DO i=1,dimsize
    1069     VarOut(i)=Buff(i)
    1070   ENDDO
    1071 !$OMP END MASTER
    1072 !$OMP BARRIER
    1073 
    1074 END SUBROUTINE reduce_sum_omp_igen
    1075 
    1076 SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
    1077   IMPLICIT NONE
    1078 
    1079   INTEGER,INTENT(IN) :: dimsize
    1080   REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
    1081   REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
    1082   REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
    1083 
    1084   INTEGER :: i
    1085 
    1086 !$OMP MASTER
    1087   Buff(:)=0
    1088 !$OMP END MASTER
    1089 !$OMP BARRIER
    1090 
    1091 !$OMP CRITICAL     
    1092   DO i=1,dimsize
    1093     Buff(i)=Buff(i)+VarIn(i)
    1094   ENDDO
    1095 !$OMP END CRITICAL
    1096 !$OMP BARRIER 
    1097 
    1098 !$OMP MASTER
    1099   DO i=1,dimsize
    1100     VarOut(i)=Buff(i)
    1101   ENDDO
    1102 !$OMP END MASTER
    1103 !$OMP BARRIER
    1104 
    1105 END SUBROUTINE reduce_sum_omp_rgen
     967    INTEGER,INTENT(IN) :: dimsize
     968    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
     969    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
     970    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
     971
     972    INTEGER :: i,ij
     973   
     974    DO i=1,dimsize
     975      DO ij=1,klon_omp
     976        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
     977      ENDDO
     978    ENDDO
     979  !$OMP BARRIER 
     980
     981
     982  !$OMP MASTER
     983    DO i=1,dimsize
     984      DO ij=1,klon_mpi
     985        VarOut(ij,i)=Buff(ij,i)
     986      ENDDO
     987    ENDDO 
     988  !$OMP END MASTER
     989  !$OMP BARRIER
     990
     991  END SUBROUTINE gather_omp_lgen
     992
     993
     994  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
     995  IMPLICIT NONE
     996
     997    INTEGER,INTENT(IN) :: dimsize
     998    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
     999    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
     1000    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
     1001
     1002    INTEGER :: i
     1003
     1004  !$OMP MASTER
     1005    Buff(:)=0
     1006  !$OMP END MASTER
     1007  !$OMP BARRIER
     1008 
     1009  !$OMP CRITICAL     
     1010    DO i=1,dimsize
     1011      Buff(i)=Buff(i)+VarIn(i)
     1012    ENDDO
     1013  !$OMP END CRITICAL
     1014  !$OMP BARRIER 
     1015 
     1016  !$OMP MASTER
     1017    DO i=1,dimsize
     1018      VarOut(i)=Buff(i)
     1019    ENDDO
     1020  !$OMP END MASTER
     1021  !$OMP BARRIER
     1022 
     1023  END SUBROUTINE reduce_sum_omp_igen
     1024
     1025  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
     1026  IMPLICIT NONE
     1027
     1028    INTEGER,INTENT(IN) :: dimsize
     1029    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
     1030    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
     1031    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
     1032
     1033    INTEGER :: i
     1034
     1035  !$OMP MASTER
     1036    Buff(:)=0
     1037  !$OMP END MASTER
     1038  !$OMP BARRIER
     1039 
     1040  !$OMP CRITICAL     
     1041    DO i=1,dimsize
     1042      Buff(i)=Buff(i)+VarIn(i)
     1043    ENDDO
     1044  !$OMP END CRITICAL
     1045  !$OMP BARRIER 
     1046 
     1047  !$OMP MASTER
     1048    DO i=1,dimsize
     1049      VarOut(i)=Buff(i)
     1050    ENDDO
     1051  !$OMP END MASTER
     1052  !$OMP BARRIER
     1053 
     1054  END SUBROUTINE reduce_sum_omp_rgen
     1055
     1056END MODULE mod_phys_lmdz_omp_transfert

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_para.F90

    r775 r1001  
    2828    CALL Test_transfert
    2929!$OMP END PARALLEL   
    30      IF (is_ok_mpi .OR. is_ok_omp) THEN
     30     IF (is_using_mpi .OR. is_using_omp) THEN
    3131       is_sequential=.FALSE.
    3232       is_parallel=.TRUE.

  • LMDZ4/trunk/libf/phylmd/oasis.F90

    r996 r1001  
    4444  !$OMP THREADPRIVATE(out_var_id)
    4545
     46  CHARACTER(LEN=*),PARAMETER :: OPA_version='OPA9'
    4647
    4748#ifdef CPP_COUPLE

  • LMDZ4/trunk/libf/phylmd/phyetat0.F

    r996 r1001  
    1717      USE surface_data,     ONLY : type_ocean
    1818      USE phys_state_var_mod
    19 
     19      USE iostart
     20      USE write_field_phy
    2021      IMPLICIT none
    2122c======================================================================
    … …  
    3536
    3637c les variables globales lues dans le fichier restart
    37       REAL rlat_glo(klon_glo), rlon_glo(klon_glo)
    38       REAL pctsrf_glo(klon_glo, nbsrf)
    39       REAL tsol_glo(klon_glo,nbsrf)
    40       REAL alb1_glo(klon_glo,nbsrf)
    41       REAL alb2_glo(klon_glo,nbsrf)
    42       REAL rain_fall_glo(klon_glo)
    43       REAL snow_fall_glo(klon_glo)
    44       real solsw_glo(klon_glo)
    45       real sollw_glo(klon_glo)
    46       REAL radsol_glo(klon_glo)
    47       REAL zmea_glo(klon_glo)
    48       REAL zstd_glo(klon_glo)
    49       REAL zsig_glo(klon_glo)
    50       REAL zgam_glo(klon_glo)
    51       REAL zthe_glo(klon_glo)
    52       REAL zpic_glo(klon_glo)
    53       REAL zval_glo(klon_glo)
    54       REAL rugsrel_glo(klon_glo)
    55       REAL t_ancien_glo(klon_glo,klev), q_ancien_glo(klon_glo,klev)
    56       REAL clwcon_glo(klon_glo,klev)
    57       REAL rnebcon_glo(klon_glo,klev)
    58       REAL ratqs_glo(klon_glo,klev)
    59       REAL pbl_tke_glo(klon_glo,klev+1,nbsrf)
    60       REAL zmax0_glo(klon_glo), f0_glo(klon)
    61       REAL ema_work1_glo(klon_glo, klev), ema_work2_glo(klon_glo, klev)
    62       REAL wake_deltat_glo(klon_glo,klev)
    63       REAL wake_deltaq_glo(klon_glo,klev)
    64       REAL wake_s_glo(klon_glo), wake_cstar_glo(klon_glo)
    65       REAL wake_fip_glo(klon_glo)
    66       REAL tsoil_p(klon,nsoilmx,nbsrf)
    67       REAL qsurf_p(klon,nbsrf)
    68       REAL qsol_p(klon)
    69       REAL snow_p(klon,nbsrf)
    70       REAL evap_p(klon,nbsrf)
    71       real fder_p(klon)
    72       REAL frugs_p(klon,nbsrf)
    73       REAL agesno_p(klon,nbsrf)
    74       REAL run_off_lic_0_p(klon)
    75      
    76       LOGICAL,SAVE ::  ancien_ok_glo
    77 !$OMP THREADPRIVATE(ancien_ok_glo) 
    78    
    79       REAL zmasq_glo(klon_glo)
    80       REAL tsoil(klon_glo,nsoilmx,nbsrf)
    81       REAL qsurf(klon_glo,nbsrf)
    82       REAL qsol(klon_glo)
    83       REAL snow(klon_glo,nbsrf)
    84       REAL evap(klon_glo,nbsrf)
    85       real fder(klon_glo)
    86       REAL frugs(klon_glo,nbsrf)
    87       REAL agesno(klon_glo,nbsrf)
    88       REAL fractint(klon_glo)
    89       REAL run_off_lic_0(klon_glo)
     38
     39      REAL tsoil(klon,nsoilmx,nbsrf)
     40      REAL tslab(klon), seaice(klon)
     41      REAL qsurf(klon,nbsrf)
     42      REAL qsol(klon)
     43      REAL snow(klon,nbsrf)
     44      REAL evap(klon,nbsrf)
     45      real fder(klon)
     46      REAL frugs(klon,nbsrf)
     47      REAL agesno(klon,nbsrf)
     48      REAL run_off_lic_0(klon)
     49      REAL fractint(klon)
    9050
    9151      CHARACTER*6 ocean_in
    … …  
    10565      CHARACTER*7 str7
    10666      CHARACTER*2 str2
     67      LOGICAL :: found
    10768
    10869c FH1D
    … …  
    11374c
    11475
    115 c$OMP MASTER
    116       print *,'MASTER -x , omp_rank=',omp_rank
    117 c$OMP END MASTER
    118 
    119 c$OMP MASTER
    120       IF (is_mpi_root) THEN
    121         print*,'fichnom ',fichnom
    122         ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
    123         IF (ierr.NE.NF_NOERR) THEN
    124           write(6,*)' Pb d''ouverture du fichier '//fichnom
    125           write(6,*)' ierr = ', ierr
    126           CALL ABORT
    127         ENDIF
    128       ENDIF
    129 c$OMP END MASTER
     76     
     77      CALL open_startphy(fichnom)
     78     
     79
    13080c
    13181c Lecture des parametres de controle:
    13282c
    133 c$OMP MASTER
    134       IF (is_mpi_root) THEN
    135      
    136       ierr = NF_INQ_VARID (nid, "controle", nvarid)
    137       IF (ierr.NE.NF_NOERR) THEN
    138          PRINT*, 'phyetat0: Le champ <controle> est absent'
    139          CALL abort
    140       ENDIF
    141 #ifdef NC_DOUBLE
    142       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
    143 #else
    144       ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
    145 #endif
    146       IF (ierr.NE.NF_NOERR) THEN
    147          PRINT*, 'phyetat0: Lecture echouee pour <controle>'
    148          CALL abort
    149       ENDIF
    150       ENDIF
    151 
    152 c$OMP END MASTER
    153        
    154        CALL bcast(tab_cntrl)
     83      CALL get_var("controle",tab_cntrl)
    15584       
    15685c
    … …  
    225154c Lecture des latitudes (coordonnees):
    226155c
    227       IF (is_mpi_root .AND. is_omp_root) THEN
    228      
    229       ierr = NF_INQ_VARID (nid, "latitude", nvarid)
    230       IF (ierr.NE.NF_NOERR) THEN
    231          PRINT*, 'phyetat0: Le champ <latitude> est absent'
    232          CALL abort
    233       ENDIF
    234 #ifdef NC_DOUBLE
    235       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat_glo)
    236 #else
    237       ierr = NF_GET_VAR_REAL(nid, nvarid, rlat_glo)
    238 #endif
    239       IF (ierr.NE.NF_NOERR) THEN
    240          PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
    241          CALL abort
    242       ENDIF
     156      CALL get_field("latitude",rlat)
    243157
    244158c
    245159c Lecture des longitudes (coordonnees):
    246160c
    247       ierr = NF_INQ_VARID (nid, "longitude", nvarid)
    248       IF (ierr.NE.NF_NOERR) THEN
    249          PRINT*, 'phyetat0: Le champ <longitude> est absent'
    250          CALL abort
    251       ENDIF
    252 #ifdef NC_DOUBLE
    253       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon_glo)
    254 #else
    255       ierr = NF_GET_VAR_REAL(nid, nvarid, rlon_glo)
    256 #endif
    257       IF (ierr.NE.NF_NOERR) THEN
    258          PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
    259          CALL abort
    260       ENDIF
     161      CALL get_field("longitude",rlon)
     162
    261163C
    262164C
    263165C Lecture du masque terre mer
    264166C
    265 
    266       ierr = NF_INQ_VARID (nid, "masque", nvarid)
    267       IF (ierr .EQ.  NF_NOERR) THEN
    268 #ifdef NC_DOUBLE
    269           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmasq_glo)
    270 #else
    271           ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq_glo)
    272 #endif
    273           IF (ierr.NE.NF_NOERR) THEN
    274               PRINT*, 'phyetat0: Lecture echouee pour <masque>'
    275               CALL abort
    276           ENDIF
    277       else
    278           PRINT*, 'phyetat0: Le champ <masque> est absent'
    279           PRINT*, 'fichier startphy non compatible avec phyetat0'
    280 C      CALL abort
     167      CALL get_field("masque",zmasq,found)
     168      IF (.NOT. found) THEN
     169        PRINT*, 'phyetat0: Le champ <masque> est absent'
     170        PRINT *, 'fichier startphy non compatible avec phyetat0'
    281171      ENDIF
    282172
    … …  
    291181C
    292182
    293       ierr = NF_INQ_VARID (nid, "FTER", nvarid)
    294       IF (ierr .EQ.  NF_NOERR) THEN
    295 #ifdef NC_DOUBLE
    296           ierr = NF_GET_VAR_DOUBLE(nid, nvarid,       
    297      .                             pctsrf_glo(1 : klon_glo,is_ter))
    298 #else
    299           ierr = NF_GET_VAR_REAL(nid, nvarid,
    300      .                           pctsrf_glo(1 : klon_glo,is_ter))
    301 #endif
    302           IF (ierr.NE.NF_NOERR) THEN
    303               PRINT*, 'phyetat0: Lecture echouee pour <FTER>'
    304               CALL abort
    305           ENDIF
    306       else
    307           PRINT*, 'phyetat0: Le champ <FTER> est absent'
    308 c@$$         CALL abort
    309       ENDIF
     183      CALL get_field("FTER",pctsrf(:,is_ter),found)
     184      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FTER> est absent'
    310185
    311186C
    312187C fraction de glace de terre
    313188C
    314       ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
    315       IF (ierr .EQ.  NF_NOERR) THEN
    316 #ifdef NC_DOUBLE
    317           ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
    318      .                             pctsrf_glo(1 : klon_glo,is_lic))
    319 #else
    320           ierr = NF_GET_VAR_REAL(nid, nvarid,
    321      .                           pctsrf_glo(1 : klon_glo,is_lic))
    322 #endif
    323           IF (ierr.NE.NF_NOERR) THEN
    324               PRINT*, 'phyetat0: Lecture echouee pour <FLIC>'
    325               CALL abort
    326           ENDIF
    327       else
    328           PRINT*, 'phyetat0: Le champ <FLIC> est absent'
    329 c@$$         CALL abort
    330       ENDIF
     189      CALL get_field("FLIC",pctsrf(:,is_lic),found)
     190      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FLIC> est absent'
     191
    331192C
    332193C fraction d'ocean
    333194C
    334       ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
    335       IF (ierr .EQ.  NF_NOERR) THEN
    336 #ifdef NC_DOUBLE
    337           ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
    338      .                             pctsrf_glo(1 : klon_glo,is_oce))
    339 #else
    340           ierr = NF_GET_VAR_REAL(nid, nvarid,
    341      .                           pctsrf_glo(1 : klon_glo,is_oce))
    342 #endif
    343           IF (ierr.NE.NF_NOERR) THEN
    344               PRINT*, 'phyetat0: Lecture echouee pour <FOCE>'
    345               CALL abort
    346           ENDIF
    347       else
    348           PRINT*, 'phyetat0: Le champ <FOCE> est absent'
    349 c@$$         CALL abort
    350       ENDIF
     195      CALL get_field("FOCE",pctsrf(:,is_oce),found)
     196      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FOCE> est absent'
    351197
    352198C
    353199C fraction glace de mer
    354200C
    355       ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
    356       IF (ierr .EQ.  NF_NOERR) THEN
    357 #ifdef NC_DOUBLE
    358           ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
    359      .                             pctsrf_glo(1 : klon_glo,is_sic))
    360 #else
    361           ierr = NF_GET_VAR_REAL(nid, nvarid,
    362      .                           pctsrf_glo(1 : klon_glo, is_sic))
    363 #endif
    364           IF (ierr.NE.NF_NOERR) THEN
    365               PRINT*, 'phyetat0: Lecture echouee pour <FSIC>'
    366               CALL abort
    367           ENDIF
    368       else
    369           PRINT*, 'phyetat0: Le champ <FSIC> est absent'
    370 c@$$         CALL abort
    371       ENDIF
     201      CALL get_field("FSIC",pctsrf(:,is_sic),found)
     202      IF (.NOT. found) PRINT*, 'phyetat0: Le champ <FSIC> est absent'
    372203
    373204C
    374205C  Verification de l'adequation entre le masque et les sous-surfaces
    375206C
    376       fractint( 1 : klon_glo) = pctsrf_glo(1 : klon_glo, is_ter)
    377      $    + pctsrf_glo(1 : klon_glo, is_lic)
    378       DO i = 1 , klon_glo
    379         IF ( abs(fractint(i) - zmasq_glo(i) ) .GT. EPSFRA ) THEN
     207      fractint( 1 : klon) = pctsrf(1 : klon, is_ter)
     208     $    + pctsrf(1 : klon, is_lic)
     209      DO i = 1 , klon
     210        IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
    380211            WRITE(*,*) 'phyetat0: attention fraction terre pas ',
    381      $          'coherente ', i, zmasq_glo(i), pctsrf_glo(i, is_ter)
    382      $          ,pctsrf_glo(i, is_lic)
     212     $          'coherente ', i, zmasq(i), pctsrf(i, is_ter)
     213     $          ,pctsrf(i, is_lic)
    383214        ENDIF
    384215      END DO
    385       fractint (1 : klon_glo) =  pctsrf_glo(1 : klon_glo, is_oce)
    386      $    + pctsrf_glo(1 : klon_glo, is_sic)
    387       DO i = 1 , klon_glo
    388         IF ( abs( fractint(i) - (1. - zmasq_glo(i))) .GT. EPSFRA ) THEN
     216      fractint (1 : klon) =  pctsrf(1 : klon, is_oce)
     217     $    + pctsrf(1 : klon, is_sic)
     218      DO i = 1 , klon
     219        IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
    389220            WRITE(*,*) 'phyetat0 attention fraction ocean pas ',
    390      $          'coherente ', i, zmasq_glo(i) , pctsrf_glo(i, is_oce)
    391      $          ,pctsrf_glo(i, is_sic)
     221     $          'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
     222     $          ,pctsrf(i, is_sic)
    392223        ENDIF
    393224      END DO
    … …  
    397228c
    398229
    399       ierr = NF_INQ_VARID (nid, "TS", nvarid)
    400       IF (ierr.NE.NF_NOERR) THEN
     230       CALL get_field("TS",ftsol(:,1),found)
     231       IF (.NOT. found) THEN
    401232         PRINT*, 'phyetat0: Le champ <TS> est absent'
    402233         PRINT*, '          Mais je vais essayer de lire TS**'
    … …  
    407238           ENDIF
    408239           WRITE(str2,'(i2.2)') nsrf
    409            ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
    410            IF (ierr.NE.NF_NOERR) THEN
    411               PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
    412               CALL abort
    413            ENDIF
    414 #ifdef NC_DOUBLE
    415            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol_glo(1,nsrf))
    416 #else
    417            ierr = NF_GET_VAR_REAL(nid, nvarid, tsol_glo(1,nsrf))
    418 #endif
    419            IF (ierr.NE.NF_NOERR) THEN
    420              PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
    421              CALL abort
    422            ENDIF
     240           CALL get_field("TS"//str2,ftsol(:,nsrf))
    423241
    424242           xmin = 1.0E+20
    425243           xmax = -1.0E+20
    426            DO i = 1, klon_glo
    427               xmin = MIN(tsol_glo(i,nsrf),xmin)
    428               xmax = MAX(tsol_glo(i,nsrf),xmax)
     244           DO i = 1, klon
     245              xmin = MIN(ftsol(i,nsrf),xmin)
     246              xmax = MAX(ftsol(i,nsrf),xmax)
    429247           ENDDO
    430248           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
    … …  
    433251         PRINT*, 'phyetat0: Le champ <TS> est present'
    434252         PRINT*, '          J ignore donc les autres temperatures TS**'
    435 #ifdef NC_DOUBLE
    436          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol_glo(1,1))
    437 #else
    438          ierr = NF_GET_VAR_REAL(nid, nvarid, tsol_glo(1,1))
    439 #endif
    440          IF (ierr.NE.NF_NOERR) THEN
    441             PRINT*, "phyetat0: Lecture echouee pour <TS>"
    442             CALL abort
    443          ENDIF
    444253         xmin = 1.0E+20
    445254         xmax = -1.0E+20
    446          DO i = 1, klon_glo
    447             xmin = MIN(tsol_glo(i,1),xmin)
    448             xmax = MAX(tsol_glo(i,1),xmax)
     255         DO i = 1, klon
     256            xmin = MIN(ftsol(i,1),xmin)
     257            xmax = MAX(ftsol(i,1),xmax)
    449258         ENDDO
    450259         PRINT*,'Temperature du sol <TS>', xmin, xmax
    451260         DO nsrf = 2, nbsrf
    452          DO i = 1, klon_glo
    453             tsol_glo(i,nsrf) = tsol_glo(i,1)
     261         DO i = 1, klon
     262            ftsol(i,nsrf) = ftsol(i,1)
    454263         ENDDO
    455264         ENDDO
    … …  
    460269c
    461270      DO nsrf = 1, nbsrf
    462       DO isoil=1, nsoilmx
    463       IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
    464          PRINT*, "Trop de couches ou sous-mailles"
    465          CALL abort
    466       ENDIF
    467       WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
    468       ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
    469       IF (ierr.NE.NF_NOERR) THEN
    470          PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
    471          PRINT*, "          Il prend donc la valeur de surface"
    472          DO i=1, klon_glo
    473              tsoil(i,isoil,nsrf)=tsol_glo(i,nsrf)
    474          ENDDO
    475       ELSE
    476 #ifdef NC_DOUBLE
    477          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
    478 #else
    479          ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
    480 #endif
    481          IF (ierr.NE.NF_NOERR) THEN
    482             PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
     271        DO isoil=1, nsoilmx
     272          IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
     273            PRINT*, "Trop de couches ou sous-mailles"
    483274            CALL abort
    484          ENDIF
    485       ENDIF
    486       ENDDO
     275          ENDIF
     276          WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
     277         
     278          CALL get_field('Tsoil'//str7,tsoil(:,isoil,nsrf),found)
     279          IF (.NOT. found) THEN
     280            PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
     281            PRINT*, "          Il prend donc la valeur de surface"
     282            DO i=1, klon
     283               tsoil(i,isoil,nsrf)=ftsol(i,nsrf)
     284            ENDDO
     285          ENDIF
     286        ENDDO
    487287      ENDDO
    488288c
    489289c Lecture de l'humidite de l'air juste au dessus du sol:
    490290c
    491       ierr = NF_INQ_VARID (nid, "QS", nvarid)
    492       IF (ierr.NE.NF_NOERR) THEN
     291
     292      CALL get_field("QS",qsurf(:,1),found)
     293      IF (.NOT. found) THEN
    493294         PRINT*, 'phyetat0: Le champ <QS> est absent'
    494295         PRINT*, '          Mais je vais essayer de lire QS**'
    … …  
    499300           ENDIF
    500301           WRITE(str2,'(i2.2)') nsrf
    501            ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
    502            IF (ierr.NE.NF_NOERR) THEN
    503               PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
    504               CALL abort
    505            ENDIF
    506 #ifdef NC_DOUBLE
    507            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,nsrf))
    508 #else
    509            ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,nsrf))
    510 #endif
    511            IF (ierr.NE.NF_NOERR) THEN
    512              PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
    513              CALL abort
    514            ENDIF
     302           CALL get_field("QS"//str2,qsurf(:,nsrf))
    515303           xmin = 1.0E+20
    516304           xmax = -1.0E+20
    517            DO i = 1, klon_glo
     305           DO i = 1, klon
    518306              xmin = MIN(qsurf(i,nsrf),xmin)
    519307              xmax = MAX(qsurf(i,nsrf),xmax)
    … …  
    524312         PRINT*, 'phyetat0: Le champ <QS> est present'
    525313         PRINT*, '          J ignore donc les autres humidites QS**'
    526 #ifdef NC_DOUBLE
    527          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,1))
    528 #else
    529          ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,1))
    530 #endif
    531          IF (ierr.NE.NF_NOERR) THEN
    532             PRINT*, "phyetat0: Lecture echouee pour <QS>"
    533             CALL abort
    534          ENDIF
    535314         xmin = 1.0E+20
    536315         xmax = -1.0E+20
    537          DO i = 1, klon_glo
     316         DO i = 1, klon
    538317            xmin = MIN(qsurf(i,1),xmin)
    539318            xmax = MAX(qsurf(i,1),xmax)
    … …  
    541320         PRINT*,'Humidite pres du sol <QS>', xmin, xmax
    542321         DO nsrf = 2, nbsrf
    543          DO i = 1, klon_glo
    544             qsurf(i,nsrf) = qsurf(i,1)
    545          ENDDO
    546          ENDDO
    547       ENDIF
     322           DO i = 1, klon
     323             qsurf(i,nsrf) = qsurf(i,1)
     324           ENDDO
     325         ENDDO
     326      ENDIF
     327
    548328C
    549329C Eau dans le sol (pour le modele de sol "bucket")
    550330C
    551       ierr = NF_INQ_VARID (nid, "QSOL", nvarid)
    552       IF (ierr .EQ.  NF_NOERR) THEN
    553 #ifdef NC_DOUBLE
    554           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol)
    555 #else
    556           ierr = NF_GET_VAR_REAL(nid, nvarid, qsol)
    557 #endif
    558           IF (ierr.NE.NF_NOERR) THEN
    559               PRINT*, 'phyetat0: Lecture echouee pour <QSOL>'
    560               CALL abort
    561           ENDIF
    562       else
    563           PRINT*, 'phyetat0: Le champ <QSOL> est absent'
    564           PRINT*, '          Valeur par defaut nulle'
     331      CALL get_field("QSOL",qsol,found)
     332      IF (.NOT. found) THEN
     333        PRINT*, 'phyetat0: Le champ <QSOL> est absent'
     334        PRINT*, '          Valeur par defaut nulle'
    565335          qsol(:)=0.
    566 c@$$         CALL abort
    567       ENDIF
    568       xmin = 1.0E+20
    569       xmax = -1.0E+20
    570       DO i = 1, klon_glo
     336      ENDIF
     337
     338      xmin = 1.0E+20
     339      xmax = -1.0E+20
     340      DO i = 1, klon
    571341        xmin = MIN(qsol(i),xmin)
    572342        xmax = MAX(qsol(i),xmax)
    573343      ENDDO
    574344      PRINT*,'Eau dans le sol (mm) <QSOL>', xmin, xmax
     345
    575346c
    576347c Lecture de neige au sol:
    577348c
    578       ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
    579       IF (ierr.NE.NF_NOERR) THEN
    580          PRINT*, 'phyetat0: Le champ <SNOW> est absent'
    581          PRINT*, '          Mais je vais essayer de lire SNOW**'
    582          DO nsrf = 1, nbsrf
    583            IF (nsrf.GT.99) THEN
    584              PRINT*, "Trop de sous-mailles"
    585              CALL abort
    586            ENDIF
    587            WRITE(str2,'(i2.2)') nsrf
    588            ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
    589            IF (ierr.NE.NF_NOERR) THEN
    590               PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
    591               CALL abort
    592            ENDIF
    593 #ifdef NC_DOUBLE
    594            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
    595 #else
    596            ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
    597 #endif
    598            IF (ierr.NE.NF_NOERR) THEN
    599              PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
    600              CALL abort
    601            ENDIF
    602            xmin = 1.0E+20
    603            xmax = -1.0E+20
    604            DO i = 1, klon_glo
    605               xmin = MIN(snow(i,nsrf),xmin)
    606               xmax = MAX(snow(i,nsrf),xmax)
    607            ENDDO
    608            PRINT*,'Neige du sol SNOW**:', nsrf, xmin, xmax
    609          ENDDO
     349
     350      CALL get_field("SNOW",snow(:,nsrf),found)
     351      IF (.NOT. found) THEN
     352        PRINT*, 'phyetat0: Le champ <SNOW> est absent'
     353        PRINT*, '          Mais je vais essayer de lire SNOW**'
     354        DO nsrf = 1, nbsrf
     355          IF (nsrf.GT.99) THEN
     356            PRINT*, "Trop de sous-mailles"
     357            CALL abort
     358          ENDIF
     359          WRITE(str2,'(i2.2)') nsrf
     360          CALL get_field( "SNOW"//str2,snow(:,nsrf))
     361          xmin = 1.0E+20
     362          xmax = -1.0E+20
     363          DO i = 1, klon
     364            xmin = MIN(snow(i,nsrf),xmin)
     365            xmax = MAX(snow(i,nsrf),xmax)
     366          ENDDO
     367          PRINT*,'Neige du sol SNOW**:', nsrf, xmin, xmax
     368        ENDDO
    610369      ELSE
    611370         PRINT*, 'phyetat0: Le champ <SNOW> est present'
    612371         PRINT*, '          J ignore donc les autres neiges SNOW**'
    613 #ifdef NC_DOUBLE
    614          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
    615 #else
    616          ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
    617 #endif
    618          IF (ierr.NE.NF_NOERR) THEN
    619             PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
    620             CALL abort
    621          ENDIF
    622372         xmin = 1.0E+20
    623373         xmax = -1.0E+20
    624          DO i = 1, klon_glo
     374         DO i = 1, klon
    625375            xmin = MIN(snow(i,1),xmin)
    626376            xmax = MAX(snow(i,1),xmax)
    … …  
    628378         PRINT*,'Neige du sol <SNOW>', xmin, xmax
    629379         DO nsrf = 2, nbsrf
    630          DO i = 1, klon_glo
     380         DO i = 1, klon
    631381            snow(i,nsrf) = snow(i,1)
    632382         ENDDO
    … …  
    636386c Lecture de albedo de l'interval visible au sol:
    637387c
    638       ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
    639       IF (ierr.NE.NF_NOERR) THEN
     388      CALL get_field("ALBE",falb1(:,1),found)
     389      IF (.NOT. found) THEN
    640390         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
    641391         PRINT*, '          Mais je vais essayer de lire ALBE**'
    … …  
    646396           ENDIF
    647397           WRITE(str2,'(i2.2)') nsrf
    648            ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid)
    649            IF (ierr.NE.NF_NOERR) THEN
    650               PRINT*, "phyetat0: Le champ <ALBE"//str2//"> est absent"
    651               CALL abort
    652            ENDIF
    653 #ifdef NC_DOUBLE
    654            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1_glo(1,nsrf))
    655 #else
    656            ierr = NF_GET_VAR_REAL(nid, nvarid, alb1_glo(1,nsrf))
    657 #endif
    658            IF (ierr.NE.NF_NOERR) THEN
    659              PRINT*, "phyetat0: Lecture echouee pour <ALBE"//str2//">"
    660              CALL abort
    661            ENDIF
     398           CALL get_field("ALBE"//str2,falb1(:,nsrf))
    662399           xmin = 1.0E+20
    663400           xmax = -1.0E+20
    664            DO i = 1, klon_glo
    665               xmin = MIN(alb1_glo(i,nsrf),xmin)
    666               xmax = MAX(alb1_glo(i,nsrf),xmax)
     401           DO i = 1, klon
     402              xmin = MIN(falb1(i,nsrf),xmin)
     403              xmax = MAX(falb1(i,nsrf),xmax)
    667404           ENDDO
    668405           PRINT*,'Albedo du sol ALBE**:', nsrf, xmin, xmax
    … …  
    671408         PRINT*, 'phyetat0: Le champ <ALBE> est present'
    672409         PRINT*, '          J ignore donc les autres ALBE**'
    673 #ifdef NC_DOUBLE
    674          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1_glo(1,1))
    675 #else
    676          ierr = NF_GET_VAR_REAL(nid, nvarid, alb1_glo(1,1))
    677 #endif
    678          IF (ierr.NE.NF_NOERR) THEN
    679             PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
    680             CALL abort
    681          ENDIF
    682410         xmin = 1.0E+20
    683411         xmax = -1.0E+20
    684          DO i = 1, klon_glo
    685             xmin = MIN(alb1_glo(i,1),xmin)
    686             xmax = MAX(alb1_glo(i,1),xmax)
     412         DO i = 1, klon
     413            xmin = MIN(falb1(i,1),xmin)
     414            xmax = MAX(falb1(i,1),xmax)
    687415         ENDDO
    688416         PRINT*,'Neige du sol <ALBE>', xmin, xmax
    689417         DO nsrf = 2, nbsrf
    690          DO i = 1, klon_glo
    691             alb1_glo(i,nsrf) = alb1_glo(i,1)
    692          ENDDO
     418           DO i = 1, klon
     419            falb1(i,nsrf) = falb1(i,1)
     420           ENDDO
    693421         ENDDO
    694422      ENDIF
    … …  
    697425c Lecture de albedo au sol dans l'interval proche infra-rouge:
    698426c
    699       ierr = NF_INQ_VARID (nid, "ALBLW", nvarid)
    700       IF (ierr.NE.NF_NOERR) THEN
     427      CALL get_field("ALBLW",falb2(:,1),found)
     428      IF (.NOT. found) THEN
    701429         PRINT*, 'phyetat0: Le champ <ALBLW> est absent'
    702 c        PRINT*, '          Mais je vais essayer de lire ALBLW**'
    703430         PRINT*, '          Mais je vais prendre ALBE**'
    704431         DO nsrf = 1, nbsrf
    705            DO i = 1, klon_glo
    706              alb2_glo(i,nsrf) = alb1_glo(i,nsrf)
     432           DO i = 1, klon
     433             falb2(i,nsrf) = falb1(i,nsrf)
    707434           ENDDO
    708435         ENDDO
    … …  
    710437         PRINT*, 'phyetat0: Le champ <ALBLW> est present'
    711438         PRINT*, '          J ignore donc les autres ALBLW**'
    712 #ifdef NC_DOUBLE
    713          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb2_glo(1,1))
    714 #else
    715          ierr = NF_GET_VAR_REAL(nid, nvarid, alb2_glo(1,1))
    716 #endif
    717          IF (ierr.NE.NF_NOERR) THEN
    718             PRINT*, "phyetat0: Lecture echouee pour <ALBLW>"
    719             CALL abort
    720          ENDIF
    721439         xmin = 1.0E+20
    722440         xmax = -1.0E+20
    723          DO i = 1, klon_glo
    724             xmin = MIN(alb2_glo(i,1),xmin)
    725             xmax = MAX(alb2_glo(i,1),xmax)
     441         DO i = 1, klon
     442            xmin = MIN(falb2(i,1),xmin)
     443            xmax = MAX(falb2(i,1),xmax)
    726444         ENDDO
    727445         PRINT*,'Neige du sol <ALBLW>', xmin, xmax
    728446         DO nsrf = 2, nbsrf
    729          DO i = 1, klon_glo
    730             alb2_glo(i,nsrf) = alb2_glo(i,1)
    731          ENDDO
     447           DO i = 1, klon
     448             falb2(i,nsrf) = falb2(i,1)
     449           ENDDO
    732450         ENDDO
    733451      ENDIF
    … …  
    735453c Lecture de evaporation: 
    736454c
    737       ierr = NF_INQ_VARID (nid, "EVAP", nvarid)
    738       IF (ierr.NE.NF_NOERR) THEN
     455      CALL get_field("EVAP",evap(:,1),found)
     456      IF (.NOT. found) THEN
    739457         PRINT*, 'phyetat0: Le champ <EVAP> est absent'
    740458         PRINT*, '          Mais je vais essayer de lire EVAP**'
    … …  
    745463           ENDIF
    746464           WRITE(str2,'(i2.2)') nsrf
    747            ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid)
    748            IF (ierr.NE.NF_NOERR) THEN
    749               PRINT*, "phyetat0: Le champ <EVAP"//str2//"> est absent"
    750               CALL abort
    751            ENDIF
    752 #ifdef NC_DOUBLE
    753            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,nsrf))
    754 #else
    755            ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf))
    756 #endif
    757            IF (ierr.NE.NF_NOERR) THEN
    758              PRINT*, "phyetat0: Lecture echouee pour <EVAP"//str2//">"
    759              CALL abort
    760            ENDIF
     465           CALL get_field("EVAP"//str2, evap(:,nsrf))
    761466           xmin = 1.0E+20
    762467           xmax = -1.0E+20
    763            DO i = 1, klon_glo
     468           DO i = 1, klon
    764469              xmin = MIN(evap(i,nsrf),xmin)
    765470              xmax = MAX(evap(i,nsrf),xmax)
    … …  
    770475         PRINT*, 'phyetat0: Le champ <EVAP> est present'
    771476         PRINT*, '          J ignore donc les autres EVAP**'
    772 #ifdef NC_DOUBLE
    773          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,1))
    774 #else
    775          ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1))
    776 #endif
    777          IF (ierr.NE.NF_NOERR) THEN
    778             PRINT*, "phyetat0: Lecture echouee pour <EVAP>"
    779             CALL abort
    780          ENDIF
    781477         xmin = 1.0E+20
    782478         xmax = -1.0E+20
    783          DO i = 1, klon_glo
     479         DO i = 1, klon
    784480            xmin = MIN(evap(i,1),xmin)
    785481            xmax = MAX(evap(i,1),xmax)
    … …  
    787483         PRINT*,'Evap du sol <EVAP>', xmin, xmax
    788484         DO nsrf = 2, nbsrf
    789          DO i = 1, klon_glo
     485         DO i = 1, klon
    790486            evap(i,nsrf) = evap(i,1)
    791487         ENDDO
    … …  
    795491c Lecture precipitation liquide:
    796492c
    797       ierr = NF_INQ_VARID (nid, "rain_f", nvarid)
    798       IF (ierr.NE.NF_NOERR) THEN
    799          PRINT*, 'phyetat0: Le champ <rain_f> est absent'
    800          CALL abort
    801       ENDIF
    802 #ifdef NC_DOUBLE
    803       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rain_fall_glo)
    804 #else
    805       ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall_glo)
    806 #endif
    807       IF (ierr.NE.NF_NOERR) THEN
    808          PRINT*, 'phyetat0: Lecture echouee pour <rain_f>'
    809          CALL abort
    810       ENDIF
    811       xmin = 1.0E+20
    812       xmax = -1.0E+20
    813       DO i = 1, klon_glo
    814          xmin = MIN(rain_fall_glo(i),xmin)
    815          xmax = MAX(rain_fall_glo(i),xmax)
     493      CALL get_field("rain_f",rain_fall)
     494      xmin = 1.0E+20
     495      xmax = -1.0E+20
     496      DO i = 1, klon
     497         xmin = MIN(rain_fall(i),xmin)
     498         xmax = MAX(rain_fall(i),xmax)
    816499      ENDDO
    817500      PRINT*,'Precipitation liquide rain_f:', xmin, xmax
    … …  
    819502c Lecture precipitation solide:
    820503c
    821       ierr = NF_INQ_VARID (nid, "snow_f", nvarid)
    822       IF (ierr.NE.NF_NOERR) THEN
    823          PRINT*, 'phyetat0: Le champ <snow_f> est absent'
    824          CALL abort
    825       ENDIF
    826 #ifdef NC_DOUBLE
    827       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow_fall_glo)
    828 #else
    829       ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall_glo)
    830 #endif
    831       IF (ierr.NE.NF_NOERR) THEN
    832          PRINT*, 'phyetat0: Lecture echouee pour <snow_f>'
    833          CALL abort
    834       ENDIF
    835       xmin = 1.0E+20
    836       xmax = -1.0E+20
    837       DO i = 1, klon_glo
    838          xmin = MIN(snow_fall_glo(i),xmin)
    839          xmax = MAX(snow_fall_glo(i),xmax)
     504      CALL get_field("snow_f",snow_fall)
     505      xmin = 1.0E+20
     506      xmax = -1.0E+20
     507      DO i = 1, klon
     508         xmin = MIN(snow_fall(i),xmin)
     509         xmax = MAX(snow_fall(i),xmax)
    840510      ENDDO
    841511      PRINT*,'Precipitation solide snow_f:', xmin, xmax
    … …  
    843513c Lecture rayonnement solaire au sol:
    844514c
    845       ierr = NF_INQ_VARID (nid, "solsw", nvarid)
    846       IF (ierr.NE.NF_NOERR) THEN
     515      CALL get_field("solsw",solsw,found)
     516      IF (.NOT. found) THEN
    847517         PRINT*, 'phyetat0: Le champ <solsw> est absent'
    848518         PRINT*, 'mis a zero'
    849          solsw_glo = 0.
    850       ELSE
    851 #ifdef NC_DOUBLE
    852         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw_glo)
    853 #else
    854         ierr = NF_GET_VAR_REAL(nid, nvarid, solsw_glo)
    855 #endif
    856         IF (ierr.NE.NF_NOERR) THEN
    857           PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
    858           CALL abort
    859         ENDIF
    860       ENDIF
    861       xmin = 1.0E+20
    862       xmax = -1.0E+20
    863       DO i = 1, klon_glo
    864          xmin = MIN(solsw_glo(i),xmin)
    865          xmax = MAX(solsw_glo(i),xmax)
     519         solsw(:) = 0.
     520      ENDIF
     521      xmin = 1.0E+20
     522      xmax = -1.0E+20
     523      DO i = 1, klon
     524         xmin = MIN(solsw(i),xmin)
     525         xmax = MAX(solsw(i),xmax)
    866526      ENDDO
    867527      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
    … …  
    869529c Lecture rayonnement IF au sol:
    870530c
    871       ierr = NF_INQ_VARID (nid, "sollw", nvarid)
    872       IF (ierr.NE.NF_NOERR) THEN
     531      CALL get_field("sollw",sollw,found)
     532      IF (.NOT. found) THEN
    873533         PRINT*, 'phyetat0: Le champ <sollw> est absent'
    874534         PRINT*, 'mis a zero'
    875          sollw_glo = 0.
    876       ELSE
    877 #ifdef NC_DOUBLE
    878         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw_glo)
    879 #else
    880         ierr = NF_GET_VAR_REAL(nid, nvarid, sollw_glo)
    881 #endif
    882         IF (ierr.NE.NF_NOERR) THEN
    883           PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
    884           CALL abort
    885         ENDIF
    886       ENDIF
    887       xmin = 1.0E+20
    888       xmax = -1.0E+20
    889       DO i = 1, klon_glo
    890          xmin = MIN(sollw_glo(i),xmin)
    891          xmax = MAX(sollw_glo(i),xmax)
     535         sollw = 0.
     536      ENDIF
     537      xmin = 1.0E+20
     538      xmax = -1.0E+20
     539      DO i = 1, klon
     540         xmin = MIN(sollw(i),xmin)
     541         xmax = MAX(sollw(i),xmax)
    892542      ENDDO
    893543      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
    … …  
    896546c Lecture derive des flux:
    897547c
    898       ierr = NF_INQ_VARID (nid, "fder", nvarid)
    899       IF (ierr.NE.NF_NOERR) THEN
     548      CALL get_field("fder",fder,found)
     549      IF (.NOT. found) THEN
    900550         PRINT*, 'phyetat0: Le champ <fder> est absent'
    901551         PRINT*, 'mis a zero'
    902552         fder = 0.
    903       ELSE
    904 #ifdef NC_DOUBLE
    905         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
    906 #else
    907         ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
    908 #endif
    909         IF (ierr.NE.NF_NOERR) THEN
    910           PRINT*, 'phyetat0: Lecture echouee pour <fder>'
    911           CALL abort
    912         ENDIF
    913       ENDIF
    914       xmin = 1.0E+20
    915       xmax = -1.0E+20
    916       DO i = 1, klon_glo
     553      ENDIF
     554      xmin = 1.0E+20
     555      xmax = -1.0E+20
     556      DO i = 1, klon
    917557         xmin = MIN(fder(i),xmin)
    918558         xmax = MAX(fder(i),xmax)
    … …  
    923563c Lecture du rayonnement net au sol:
    924564c
    925       ierr = NF_INQ_VARID (nid, "RADS", nvarid)
    926       IF (ierr.NE.NF_NOERR) THEN
    927          PRINT*, 'phyetat0: Le champ <RADS> est absent'
    928          CALL abort
    929       ENDIF
    930 #ifdef NC_DOUBLE
    931       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol_glo)
    932 #else
    933       ierr = NF_GET_VAR_REAL(nid, nvarid, radsol_glo)
    934 #endif
    935       IF (ierr.NE.NF_NOERR) THEN
    936          PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
    937          CALL abort
    938       ENDIF
    939       xmin = 1.0E+20
    940       xmax = -1.0E+20
    941       DO i = 1, klon_glo
    942          xmin = MIN(radsol_glo(i),xmin)
    943          xmax = MAX(radsol_glo(i),xmax)
     565      CALL get_field("RADS",radsol)
     566      xmin = 1.0E+20
     567      xmax = -1.0E+20
     568      DO i = 1, klon
     569         xmin = MIN(radsol(i),xmin)
     570         xmax = MAX(radsol(i),xmax)
    944571      ENDDO
    945572      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
    … …  
    948575c
    949576c
    950       ierr = NF_INQ_VARID (nid, "RUG", nvarid)
    951       IF (ierr.NE.NF_NOERR) THEN
     577      CALL get_field("RUG",frugs(:,1),found)
     578      IF (.NOT. found) THEN
    952579         PRINT*, 'phyetat0: Le champ <RUG> est absent'
    953580         PRINT*, '          Mais je vais essayer de lire RUG**'
    … …  
    958585           ENDIF
    959586           WRITE(str2,'(i2.2)') nsrf
    960            ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)
    961            IF (ierr.NE.NF_NOERR) THEN
    962               PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"
    963               CALL abort
    964            ENDIF
    965 #ifdef NC_DOUBLE
    966            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf))
    967 #else
    968            ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))
    969 #endif
    970            IF (ierr.NE.NF_NOERR) THEN
    971              PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"
    972              CALL abort
    973            ENDIF
     587           CALL get_field("RUG"//str2,frugs(:,nsrf))
    974588           xmin = 1.0E+20
    975589           xmax = -1.0E+20
    976            DO i = 1, klon_glo
     590           DO i = 1, klon
    977591              xmin = MIN(frugs(i,nsrf),xmin)
    978592              xmax = MAX(frugs(i,nsrf),xmax)
    … …  
    983597         PRINT*, 'phyetat0: Le champ <RUG> est present'
    984598         PRINT*, '          J ignore donc les autres RUG**'
    985 #ifdef NC_DOUBLE
    986          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1))
    987 #else
    988          ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))
    989 #endif
    990          IF (ierr.NE.NF_NOERR) THEN
    991             PRINT*, "phyetat0: Lecture echouee pour <RUG>"
    992             CALL abort
    993          ENDIF
    994599         xmin = 1.0E+20
    995600         xmax = -1.0E+20
    996          DO i = 1, klon_glo
     601         DO i = 1, klon
    997602            xmin = MIN(frugs(i,1),xmin)
    998603            xmax = MAX(frugs(i,1),xmax)
    … …  
    1000605         PRINT*,'rugosite <RUG>', xmin, xmax
    1001606         DO nsrf = 2, nbsrf
    1002          DO i = 1, klon_glo
     607         DO i = 1, klon
    1003608            frugs(i,nsrf) = frugs(i,1)
    1004609         ENDDO
    … …  
    1009614c Lecture de l'age de la neige:
    1010615c
    1011       ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
    1012       IF (ierr.NE.NF_NOERR) THEN
     616      CALL get_field("AGESNO",agesno(:,1),found)
     617      IF (.NOT. found) THEN
    1013618         PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
    1014619         PRINT*, '          Mais je vais essayer de lire AGESNO**'
    … …  
    1019624           ENDIF
    1020625           WRITE(str2,'(i2.2)') nsrf
    1021            ierr = NF_INQ_VARID (nid, "AGESNO"//str2, nvarid)
    1022            IF (ierr.NE.NF_NOERR) THEN
     626           CALL get_field("AGESNO"//str2,agesno(:,nsrf),found)
     627           IF (.NOT. found) THEN
    1023628              PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
    1024629              agesno = 50.0
    1025630           ENDIF
    1026 #ifdef NC_DOUBLE
    1027            ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,nsrf))
    1028 #else
    1029            ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,nsrf))
    1030 #endif
    1031            IF (ierr.NE.NF_NOERR) THEN
    1032              PRINT*, "phyetat0: Lecture echouee pour <AGESNO"//str2//">"
    1033              CALL abort
    1034            ENDIF
    1035631           xmin = 1.0E+20
    1036632           xmax = -1.0E+20
    1037            DO i = 1, klon_glo
     633           DO i = 1, klon
    1038634              xmin = MIN(agesno(i,nsrf),xmin)
    1039635              xmax = MAX(agesno(i,nsrf),xmax)
    … …  
    1044640         PRINT*, 'phyetat0: Le champ <AGESNO> est present'
    1045641         PRINT*, '          J ignore donc les autres AGESNO**'
    1046 #ifdef NC_DOUBLE
    1047          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,1))
    1048 #else
    1049          ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,1))
    1050 #endif
    1051          IF (ierr.NE.NF_NOERR) THEN
    1052             PRINT*, "phyetat0: Lecture echouee pour <AGESNO>"
    1053             CALL abort
    1054          ENDIF
    1055642         xmin = 1.0E+20
    1056643         xmax = -1.0E+20
    1057          DO i = 1, klon_glo
     644         DO i = 1, klon
    1058645            xmin = MIN(agesno(i,1),xmin)
    1059646            xmax = MAX(agesno(i,1),xmax)
    … …  
    1061648         PRINT*,'Age de la neige <AGESNO>', xmin, xmax
    1062649         DO nsrf = 2, nbsrf
    1063          DO i = 1, klon_glo
     650         DO i = 1, klon
    1064651            agesno(i,nsrf) = agesno(i,1)
    1065652         ENDDO
    … …  
    1068655
    1069656c
    1070       ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
    1071       IF (ierr.NE.NF_NOERR) THEN
    1072          PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
    1073          CALL abort
    1074       ENDIF
    1075 #ifdef NC_DOUBLE
    1076       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea_glo)
    1077 #else
    1078       ierr = NF_GET_VAR_REAL(nid, nvarid, zmea_glo)
    1079 #endif
    1080       IF (ierr.NE.NF_NOERR) THEN
    1081          PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
    1082          CALL abort
    1083       ENDIF
    1084       xmin = 1.0E+20
    1085       xmax = -1.0E+20
    1086       DO i = 1, klon_glo
    1087          xmin = MIN(zmea_glo(i),xmin)
    1088          xmax = MAX(zmea_glo(i),xmax)
     657      CALL get_field("ZMEA", zmea)
     658      xmin = 1.0E+20
     659      xmax = -1.0E+20
     660      DO i = 1, klon
     661         xmin = MIN(zmea(i),xmin)
     662         xmax = MAX(zmea(i),xmax)
    1089663      ENDDO
    1090664      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
    1091665c
    1092666c
    1093       ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
    1094       IF (ierr.NE.NF_NOERR) THEN
    1095          PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
    1096          CALL abort
    1097       ENDIF
    1098 #ifdef NC_DOUBLE
    1099       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd_glo)
    1100 #else
    1101       ierr = NF_GET_VAR_REAL(nid, nvarid, zstd_glo)
    1102 #endif
    1103       IF (ierr.NE.NF_NOERR) THEN
    1104          PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
    1105          CALL abort
    1106       ENDIF
    1107       xmin = 1.0E+20
    1108       xmax = -1.0E+20
    1109       DO i = 1, klon_glo
    1110          xmin = MIN(zstd_glo(i),xmin)
    1111          xmax = MAX(zstd_glo(i),xmax)
     667      CALL get_field("ZSTD",zstd)
     668      xmin = 1.0E+20
     669      xmax = -1.0E+20
     670      DO i = 1, klon
     671         xmin = MIN(zstd(i),xmin)
     672         xmax = MAX(zstd(i),xmax)
    1112673      ENDDO
    1113674      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
    1114675c
    1115676c
    1116       ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
    1117       IF (ierr.NE.NF_NOERR) THEN
    1118          PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
    1119          CALL abort
    1120       ENDIF
    1121 #ifdef NC_DOUBLE
    1122       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig_glo)
    1123 #else
    1124       ierr = NF_GET_VAR_REAL(nid, nvarid, zsig_glo)
    1125 #endif
    1126       IF (ierr.NE.NF_NOERR) THEN
    1127          PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
    1128          CALL abort
    1129       ENDIF
    1130       xmin = 1.0E+20
    1131       xmax = -1.0E+20
    1132       DO i = 1, klon_glo
    1133          xmin = MIN(zsig_glo(i),xmin)
    1134          xmax = MAX(zsig_glo(i),xmax)
     677      CALL get_field("ZSIG",zsig)
     678      xmin = 1.0E+20
     679      xmax = -1.0E+20
     680      DO i = 1, klon
     681         xmin = MIN(zsig(i),xmin)
     682         xmax = MAX(zsig(i),xmax)
    1135683      ENDDO
    1136684      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
    1137685c
    1138686c
    1139       ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
    1140       IF (ierr.NE.NF_NOERR) THEN
    1141          PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
    1142          CALL abort
    1143       ENDIF
    1144 #ifdef NC_DOUBLE
    1145       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam_glo)
    1146 #else
    1147       ierr = NF_GET_VAR_REAL(nid, nvarid, zgam_glo)
    1148 #endif
    1149       IF (ierr.NE.NF_NOERR) THEN
    1150          PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
    1151          CALL abort
    1152       ENDIF
    1153       xmin = 1.0E+20
    1154       xmax = -1.0E+20
    1155       DO i = 1, klon_glo
    1156          xmin = MIN(zgam_glo(i),xmin)
    1157          xmax = MAX(zgam_glo(i),xmax)
     687      CALL get_field("ZGAM",zgam)
     688      xmin = 1.0E+20
     689      xmax = -1.0E+20
     690      DO i = 1, klon
     691         xmin = MIN(zgam(i),xmin)
     692         xmax = MAX(zgam(i),xmax)
    1158693      ENDDO
    1159694      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
    1160695c
    1161696c
    1162       ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
    1163       IF (ierr.NE.NF_NOERR) THEN
    1164          PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
    1165          CALL abort
    1166       ENDIF
    1167 #ifdef NC_DOUBLE
    1168       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe_glo)
    1169 #else
    1170       ierr = NF_GET_VAR_REAL(nid, nvarid, zthe_glo)
    1171 #endif
    1172       IF (ierr.NE.NF_NOERR) THEN
    1173          PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
    1174          CALL abort
    1175       ENDIF
    1176       xmin = 1.0E+20
    1177       xmax = -1.0E+20
    1178       DO i = 1, klon_glo
    1179          xmin = MIN(zthe_glo(i),xmin)
    1180          xmax = MAX(zthe_glo(i),xmax)
     697      CALL get_field("ZTHE",zthe)
     698      xmin = 1.0E+20
     699      xmax = -1.0E+20
     700      DO i = 1, klon
     701         xmin = MIN(zthe(i),xmin)
     702         xmax = MAX(zthe(i),xmax)
    1181703      ENDDO
    1182704      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
    1183705c
    1184706c
    1185       ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
    1186       IF (ierr.NE.NF_NOERR) THEN
    1187          PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
    1188          CALL abort
    1189       ENDIF
    1190 #ifdef NC_DOUBLE
    1191       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic_glo)
    1192 #else
    1193       ierr = NF_GET_VAR_REAL(nid, nvarid, zpic_glo)
    1194 #endif
    1195       IF (ierr.NE.NF_NOERR) THEN
    1196          PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
    1197          CALL abort
    1198       ENDIF
    1199       xmin = 1.0E+20
    1200       xmax = -1.0E+20
    1201       DO i = 1, klon_glo
    1202          xmin = MIN(zpic_glo(i),xmin)
    1203          xmax = MAX(zpic_glo(i),xmax)
     707      CALL get_field("ZPIC",zpic)
     708      xmin = 1.0E+20
     709      xmax = -1.0E+20
     710      DO i = 1, klon
     711         xmin = MIN(zpic(i),xmin)
     712         xmax = MAX(zpic(i),xmax)
    1204713      ENDDO
    1205714      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
    1206715c
    1207       ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
    1208       IF (ierr.NE.NF_NOERR) THEN
    1209          PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
    1210          CALL abort
    1211       ENDIF
    1212 #ifdef NC_DOUBLE
    1213       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval_glo)
    1214 #else
    1215       ierr = NF_GET_VAR_REAL(nid, nvarid, zval_glo)
    1216 #endif
    1217       IF (ierr.NE.NF_NOERR) THEN
    1218          PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
    1219          CALL abort
    1220       ENDIF
    1221       xmin = 1.0E+20
    1222       xmax = -1.0E+20
    1223       DO i = 1, klon_glo
    1224          xmin = MIN(zval_glo(i),xmin)
    1225          xmax = MAX(zval_glo(i),xmax)
     716      CALL get_field("ZVAL",zval)
     717      xmin = 1.0E+20
     718      xmax = -1.0E+20
     719      DO i = 1, klon
     720         xmin = MIN(zval(i),xmin)
     721         xmax = MAX(zval(i),xmax)
    1226722      ENDDO
    1227723      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
    1228724c
    1229725c
    1230       ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
    1231       IF (ierr.NE.NF_NOERR) THEN
    1232          PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
    1233          CALL abort
    1234       ENDIF
    1235 #ifdef NC_DOUBLE
    1236       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel_glo)
    1237 #else
    1238       ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel_glo)
    1239 #endif
    1240       IF (ierr.NE.NF_NOERR) THEN
    1241          PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
    1242          CALL abort
    1243       ENDIF
    1244       xmin = 1.0E+20
    1245       xmax = -1.0E+20
    1246       DO i = 1, klon_glo
    1247          xmin = MIN(rugsrel_glo(i),xmin)
    1248          xmax = MAX(rugsrel_glo(i),xmax)
     726      CALL get_field("RUGSREL",rugoro)
     727      xmin = 1.0E+20
     728      xmax = -1.0E+20
     729      DO i = 1, klon
     730         xmin = MIN(rugoro(i),xmin)
     731         xmax = MAX(rugoro(i),xmax)
    1249732      ENDDO
    1250733      PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
    1251734c
    1252735c
    1253       ancien_ok_glo = .TRUE.
    1254 c
    1255       ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
    1256       IF (ierr.NE.NF_NOERR) THEN
     736     
     737c
     738      ancien_ok = .TRUE.
     739
     740      CALL get_field("TANCIEN",t_ancien,found)
     741      IF (.NOT. found) THEN
    1257742         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
    1258743         PRINT*, "Depart legerement fausse. Mais je continue"
    1259          ancien_ok_glo = .FALSE.
    1260       ELSE
    1261 #ifdef NC_DOUBLE
    1262          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien_glo)
    1263 #else
    1264          ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien_glo)
    1265 #endif
    1266          IF (ierr.NE.NF_NOERR) THEN
    1267             PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
    1268             CALL abort
    1269          ENDIF
    1270       ENDIF
    1271 c
    1272       ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
    1273       IF (ierr.NE.NF_NOERR) THEN
     744         ancien_ok = .FALSE.
     745      ENDIF
     746
     747
     748      CALL get_field("QANCIEN",q_ancien,found)
     749      IF (.NOT. found) THEN
    1274750         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
    1275751         PRINT*, "Depart legerement fausse. Mais je continue"
    1276          ancien_ok_glo = .FALSE.
    1277       ELSE
    1278 #ifdef NC_DOUBLE
    1279          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien_glo)
    1280 #else
    1281          ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien_glo)
    1282 #endif
    1283          IF (ierr.NE.NF_NOERR) THEN
    1284             PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
    1285             CALL abort
    1286          ENDIF
    1287       ENDIF
    1288 c
    1289       clwcon_glo=0.
    1290       ierr = NF_INQ_VARID (nid, "CLWCON", nvarid)
    1291       IF (ierr.NE.NF_NOERR) THEN
     752         ancien_ok = .FALSE.
     753      ENDIF
     754
     755c
     756
     757      clwcon=0.
     758      CALL get_field("CLWCON",clwcon(:,1),found)
     759      IF (.NOT. found) THEN
    1292760         PRINT*, "phyetat0: Le champ CLWCON est absent"
    1293761         PRINT*, "Depart legerement fausse. Mais je continue"
    1294 c        clwcon_glo = 0.
    1295       ELSE
    1296 #ifdef NC_DOUBLE
    1297          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, clwcon_glo)
    1298 #else
    1299          ierr = NF_GET_VAR_REAL(nid, nvarid, clwcon_glo)
    1300 #endif
    1301          IF (ierr.NE.NF_NOERR) THEN
    1302             PRINT*, "phyetat0: Lecture echouee pour <CLWCON>"
    1303             CALL abort
    1304          ENDIF
    1305       ENDIF
    1306       xmin = 1.0E+20
    1307       xmax = -1.0E+20
    1308       xmin = MINval(clwcon_glo)
    1309       xmax = MAXval(clwcon_glo)
     762      ENDIF
     763      xmin = 1.0E+20
     764      xmax = -1.0E+20
     765      xmin = MINval(clwcon)
     766      xmax = MAXval(clwcon)
    1310767      PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
    1311768c
    1312       rnebcon_glo = 0.
    1313       ierr = NF_INQ_VARID (nid, "RNEBCON", nvarid)
    1314       IF (ierr.NE.NF_NOERR) THEN
     769      rnebcon = 0.
     770      CALL get_field("RNEBCON",rnebcon(:,1),found)
     771      IF (.NOT. found) THEN
    1315772         PRINT*, "phyetat0: Le champ RNEBCON est absent"
    1316773         PRINT*, "Depart legerement fausse. Mais je continue"
    1317 c        rnebcon_glo = 0.
    1318       ELSE
    1319 #ifdef NC_DOUBLE
    1320          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rnebcon_glo)
    1321 #else
    1322          ierr = NF_GET_VAR_REAL(nid, nvarid, rnebcon_glo)
    1323 #endif
    1324          IF (ierr.NE.NF_NOERR) THEN
    1325             PRINT*, "phyetat0: Lecture echouee pour <RNEBCON>"
    1326             CALL abort
    1327          ENDIF
    1328       ENDIF
    1329       xmin = 1.0E+20
    1330       xmax = -1.0E+20
    1331       xmin = MINval(rnebcon_glo)
    1332       xmax = MAXval(rnebcon_glo)
     774      ENDIF
     775      xmin = 1.0E+20
     776      xmax = -1.0E+20
     777      xmin = MINval(rnebcon)
     778      xmax = MAXval(rnebcon)
    1333779      PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
    1334780
    … …  
    1336782c Lecture ratqs
    1337783c
    1338       ratqs_glo=0.
    1339       ierr = NF_INQ_VARID (nid, "RATQS", nvarid)
    1340       IF (ierr.NE.NF_NOERR) THEN
     784      ratqs=0.
     785      CALL get_field("RATQS",ratqs(:,1),found)
     786      IF (.NOT. found) THEN
    1341787         PRINT*, "phyetat0: Le champ <RATQS> est absent"
    1342788         PRINT*, "Depart legerement fausse. Mais je continue"
    1343          ratqs_glo = 0.
    1344       ELSE
    1345 #ifdef NC_DOUBLE
    1346          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ratqs_glo)
    1347 #else
    1348          ierr = NF_GET_VAR_REAL(nid, nvarid, ratqs_glo)
    1349 #endif
    1350          IF (ierr.NE.NF_NOERR) THEN
    1351             PRINT*, "phyetat0: Lecture echouee pour <RATQS>"
    1352             CALL abort
    1353          ENDIF
    1354       ENDIF
    1355       xmin = 1.0E+20
    1356       xmax = -1.0E+20
    1357       xmin = MINval(ratqs_glo)
    1358       xmax = MAXval(ratqs_glo)
     789      ENDIF
     790      xmin = 1.0E+20
     791      xmax = -1.0E+20
     792      xmin = MINval(ratqs)
     793      xmax = MAXval(ratqs)
    1359794      PRINT*,'(ecart-type) ratqs:', xmin, xmax
    1360795c
    1361796c Lecture run_off_lic_0
    1362797c
    1363       ierr = NF_INQ_VARID (nid, "RUNOFFLIC0", nvarid)
    1364       IF (ierr.NE.NF_NOERR) THEN
     798      CALL get_field("RUNOFFLIC0",run_off_lic_0,found)
     799      IF (.NOT. found) THEN
    1365800         PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"
    1366801         PRINT*, "Depart legerement fausse. Mais je continue"
    1367802         run_off_lic_0 = 0.
    1368       ELSE
    1369 #ifdef NC_DOUBLE
    1370          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, run_off_lic_0)
    1371 #else
    1372          ierr = NF_GET_VAR_REAL(nid, nvarid, run_off_lic_0)
    1373 #endif
    1374          IF (ierr.NE.NF_NOERR) THEN
    1375             PRINT*, "phyetat0: Lecture echouee pour <RUNOFFLIC0>"
    1376             CALL abort
    1377          ENDIF
    1378803      ENDIF
    1379804      xmin = 1.0E+20
    … …  
    1388813
    1389814      IF (iflag_pbl>1) then
    1390          PRINT*, 'phyetat0: Le champ <TKE> est absent'
    1391          PRINT*, '          Mais je vais essayer de lire TKE**'
    1392          DO nsrf = 1, nbsrf
    1393            IF (nsrf.GT.99) THEN
    1394              PRINT*, "Trop de sous-mailles"
    1395              CALL abort
    1396            ENDIF
    1397            WRITE(str2,'(i2.2)') nsrf
    1398            ierr = NF_INQ_VARID (nid, "TKE"//str2, nvarid)
    1399            IF (ierr.NE.NF_NOERR) THEN
    1400               PRINT*, "WARNING phyetat0: <TKE"//str2//"> est absent"
    1401               pbl_tke_glo(:,:,nsrf)=1.e-8
    1402            ELSE
    1403 #ifdef NC_DOUBLE
    1404               ierr = NF_GET_VAR_DOUBLE(nid, nvarid,
    1405      &                                pbl_tke_glo(1,1,nsrf))
    1406 #else
    1407               ierr = NF_GET_VAR_REAL(nid, nvarid, pbl_tke_glo(1,1,nsrf))
    1408 #endif
    1409               IF (ierr.NE.NF_NOERR) THEN
    1410                 PRINT*, "WARNING phyetat0: echec lect <TKE"//str2//">"
    1411                 CALL abort
    1412               ENDIF
    1413            ENDIF
    1414 
    1415            xmin = 1.0E+20
    1416            xmax = -1.0E+20
    1417            DO k = 1, klev
    1418            DO i = 1, klon_glo
    1419               xmin = MIN(pbl_tke_glo(i,k,nsrf),xmin)
    1420               xmax = MAX(pbl_tke_glo(i,k,nsrf),xmax)
    1421            ENDDO
    1422            ENDDO
    1423            PRINT*,'Temperature du sol TKE**:', nsrf, xmin, xmax
    1424          ENDDO
     815        DO nsrf = 1, nbsrf
     816          IF (nsrf.GT.99) THEN
     817            PRINT*, "Trop de sous-mailles"
     818            CALL abort
     819          ENDIF
     820          WRITE(str2,'(i2.2)') nsrf
     821          CALL get_field("TKE"//str2,pbl_tke(:,1:klev,nsrf),found)
     822          IF (.NOT. found) THEN
     823            PRINT*, "phyetat0: <TKE"//str2//"> est absent"
     824            pbl_tke(:,:,nsrf)=1.e-8
     825          ENDIF
     826          xmin = 1.0E+20
     827          xmax = -1.0E+20
     828          DO k = 1, klev
     829            DO i = 1, klon
     830              xmin = MIN(pbl_tke(i,k,nsrf),xmin)
     831              xmax = MAX(pbl_tke(i,k,nsrf),xmax)
     832            ENDDO
     833          ENDDO
     834          PRINT*,'Temperature du sol TKE**:', nsrf, xmin, xmax
     835        ENDDO
    1425836      ENDIF
    1426837c
    1427838c zmax0
    1428       ierr = NF_INQ_VARID (nid, "ZMAX0", nvarid)
    1429       IF (ierr.NE.NF_NOERR) THEN
    1430          PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
    1431          PRINT*, "Depart legerement fausse. Mais je continue"
    1432          zmax0_glo=40.
    1433       ELSE
    1434 #ifdef NC_DOUBLE
    1435          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmax0_glo)
    1436 #else
    1437          ierr = NF_GET_VAR_REAL(nid, nvarid, zmax0_glo)
    1438 #endif
    1439          IF (ierr.NE.NF_NOERR) THEN
    1440             PRINT*, "phyetat0: Lecture echouee pour <ZMAX0>"
    1441             CALL abort
    1442          ENDIF
    1443       ENDIF
    1444       xmin = 1.0E+20
    1445       xmax = -1.0E+20
    1446       xmin = MINval(zmax0_glo)
    1447       xmax = MAXval(zmax0_glo)
     839      CALL get_field("ZMAX0",zmax0,found)
     840      IF (.NOT. found) THEN
     841        PRINT*, "phyetat0: Le champ <ZMAX0> est absent"
     842        PRINT*, "Depart legerement fausse. Mais je continue"
     843        zmax0=40.
     844      ENDIF
     845      xmin = 1.0E+20
     846      xmax = -1.0E+20
     847      xmin = MINval(zmax0)
     848      xmax = MAXval(zmax0)
    1448849      PRINT*,'(ecart-type) zmax0:', xmin, xmax
    1449850c
    1450851c           f0(ig)=1.e-5
    1451852c f0
    1452       ierr = NF_INQ_VARID (nid, "f0", nvarid)
    1453       IF (ierr.NE.NF_NOERR) THEN
     853      CALL get_field("f0",f0,found)
     854      IF (.NOT. found) THEN
    1454855         PRINT*, "phyetat0: Le champ <f0> est absent"
    1455856         PRINT*, "Depart legerement fausse. Mais je continue"
    1456          f0_glo=1.e-5
    1457       ELSE
    1458 #ifdef NC_DOUBLE
    1459          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, f0_glo)
    1460 #else
    1461          ierr = NF_GET_VAR_REAL(nid, nvarid, f0_glo)
    1462 #endif
    1463          IF (ierr.NE.NF_NOERR) THEN
    1464             PRINT*, "phyetat0: Lecture echouee pour <f0>"
    1465             CALL abort
    1466          ENDIF
    1467       ENDIF
    1468       xmin = 1.0E+20
    1469       xmax = -1.0E+20
    1470       xmin = MINval(f0_glo)
    1471       xmax = MAXval(f0_glo)
     857         f0=1.e-5
     858      ENDIF
     859      xmin = 1.0E+20
     860      xmax = -1.0E+20
     861      xmin = MINval(f0)
     862      xmax = MAXval(f0)
    1472863      PRINT*,'(ecart-type) f0:', xmin, xmax
    1473864c
    1474865c ema_work1
    1475866c
    1476       ierr = NF_INQ_VARID (nid, "EMA_WORK1", nvarid)
    1477       IF (ierr.NE.NF_NOERR) THEN
    1478          PRINT*, "phyetat0: Le champ <EMA_WORK1> est absent"
    1479          PRINT*, "Depart legerement fausse. Mais je continue"
    1480          ema_work1_glo=0.
    1481       ELSE
    1482 #ifdef NC_DOUBLE
    1483          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ema_work1_glo)
    1484 #else
    1485          ierr = NF_GET_VAR_REAL(nid, nvarid, ema_work1_glo)
    1486 #endif
    1487          IF (ierr.NE.NF_NOERR) THEN
    1488             PRINT*, "phyetat0: Lecture echouee pour <EMA_WORK1>"
    1489             CALL abort
    1490          ENDIF
    1491            xmin = 1.0E+20
    1492            xmax = -1.0E+20
    1493            DO k = 1, klev
    1494            DO i = 1, klon
    1495               xmin = MIN(ema_work1_glo(i,k),xmin)
    1496               xmax = MAX(ema_work1_glo(i,k),xmax)
    1497            ENDDO
    1498            ENDDO
    1499            PRINT*,'ema_work1:', xmin, xmax
     867      CALL get_field("EMA_WORK1",ema_work1,found)
     868      IF (.NOT. found) THEN
     869        PRINT*, "phyetat0: Le champ <EMA_WORK1> est absent"
     870        PRINT*, "Depart legerement fausse. Mais je continue"
     871        ema_work1=0.
     872      ELSE
     873        xmin = 1.0E+20
     874        xmax = -1.0E+20
     875        DO k = 1, klev
     876          DO i = 1, klon
     877            xmin = MIN(ema_work1(i,k),xmin)
     878            xmax = MAX(ema_work1(i,k),xmax)
     879          ENDDO
     880        ENDDO
     881        PRINT*,'ema_work1:', xmin, xmax
    1500882      ENDIF
    1501883c
    1502884c ema_work2
    1503885c
    1504       ierr = NF_INQ_VARID (nid, "EMA_WORK2", nvarid)
    1505       IF (ierr.NE.NF_NOERR) THEN
    1506          PRINT*, "phyetat0: Le champ <EMA_WORK2> est absent"
    1507          PRINT*, "Depart legerement fausse. Mais je continue"
    1508          ema_work2_glo=0.
    1509       ELSE
    1510 #ifdef NC_DOUBLE
    1511          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ema_work2_glo)
    1512 #else
    1513          ierr = NF_GET_VAR_REAL(nid, nvarid, ema_work2_glo)
    1514 #endif
    1515          IF (ierr.NE.NF_NOERR) THEN
    1516             PRINT*, "phyetat0: Lecture echouee pour <EMA_WORK2>"
    1517             CALL abort
    1518          ENDIF
    1519            xmin = 1.0E+20
    1520            xmax = -1.0E+20
    1521            DO k = 1, klev
    1522            DO i = 1, klon
    1523               xmin = MIN(ema_work2_glo(i,k),xmin)
    1524               xmax = MAX(ema_work2_glo(i,k),xmax)
    1525            ENDDO
    1526            ENDDO
    1527            PRINT*,'ema_work2:', xmin, xmax
     886      CALL get_field("EMA_WORK2",ema_work2,found)
     887      IF (.NOT. found) THEN
     888        PRINT*, "phyetat0: Le champ <EMA_WORK2> est absent"
     889        PRINT*, "Depart legerement fausse. Mais je continue"
     890        ema_work2=0.
     891      ELSE
     892        xmin = 1.0E+20
     893        xmax = -1.0E+20
     894        DO k = 1, klev
     895          DO i = 1, klon
     896            xmin = MIN(ema_work2(i,k),xmin)
     897            xmax = MAX(ema_work2(i,k),xmax)
     898          ENDDO
     899        ENDDO
     900        PRINT*,'ema_work2:', xmin, xmax
    1528901      ENDIF
    1529902c
    1530903c wake_deltat
    1531904c
    1532       ierr = NF_INQ_VARID (nid, "WAKE_DELTAT", nvarid)
    1533       IF (ierr.NE.NF_NOERR) THEN
    1534          PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
    1535          PRINT*, "Depart legerement fausse. Mais je continue"
    1536          wake_deltat_glo=0.
    1537       ELSE
    1538 #ifdef NC_DOUBLE
    1539          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_deltat_glo)
    1540 #else
    1541          ierr = NF_GET_VAR_REAL(nid, nvarid, wake_deltat_glo)
    1542 #endif
    1543          IF (ierr.NE.NF_NOERR) THEN
    1544             PRINT*, "phyetat0: Lecture echouee pour <WAKE_DELTAT>"
    1545             CALL abort
    1546          ENDIF
    1547            xmin = 1.0E+20
    1548            xmax = -1.0E+20
    1549            DO k = 1, klev
    1550            DO i = 1, klon_glo
    1551               xmin = MIN(wake_deltat_glo(i,k),xmin)
    1552               xmax = MAX(wake_deltat_glo(i,k),xmax)
    1553            ENDDO
    1554            ENDDO
    1555            PRINT*,'wake_deltat:', xmin, xmax
     905      CALL get_field("WAKE_DELTAT",wake_deltat,found)
     906      IF (.NOT. found) THEN
     907        PRINT*, "phyetat0: Le champ <WAKE_DELTAT> est absent"
     908        PRINT*, "Depart legerement fausse. Mais je continue"
     909        wake_deltat=0.
     910      ELSE
     911        xmin = 1.0E+20
     912        xmax = -1.0E+20
     913        DO k = 1, klev
     914          DO i = 1, klon
     915            xmin = MIN(wake_deltat(i,k),xmin)
     916            xmax = MAX(wake_deltat(i,k),xmax)
     917          ENDDO
     918        ENDDO
     919        PRINT*,'wake_deltat:', xmin, xmax
    1556920      ENDIF
    1557921c
    1558922c wake_deltaq
    1559 c
    1560       ierr = NF_INQ_VARID (nid, "WAKE_DELTAQ", nvarid)
    1561       IF (ierr.NE.NF_NOERR) THEN
    1562          PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
    1563          PRINT*, "Depart legerement fausse. Mais je continue"
    1564          wake_deltaq_glo=0.
    1565       ELSE
    1566 #ifdef NC_DOUBLE
    1567          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_deltaq_glo)
    1568 #else
    1569          ierr = NF_GET_VAR_REAL(nid, nvarid, wake_deltaq_glo)
    1570 #endif
    1571          IF (ierr.NE.NF_NOERR) THEN
    1572             PRINT*, "phyetat0: Lecture echouee pour <WAKE_DELTAQ>"
    1573             CALL abort
    1574          ENDIF
    1575            xmin = 1.0E+20
    1576            xmax = -1.0E+20
    1577            DO k = 1, klev
    1578            DO i = 1, klon_glo
    1579               xmin = MIN(wake_deltaq_glo(i,k),xmin)
    1580               xmax = MAX(wake_deltaq_glo(i,k),xmax)
    1581            ENDDO
    1582            ENDDO
    1583            PRINT*,'wake_deltaq:', xmin, xmax
     923c   
     924      CALL get_field("WAKE_DELTAQ",wake_deltaq,found)
     925      IF (.NOT. found) THEN
     926        PRINT*, "phyetat0: Le champ <WAKE_DELTAQ> est absent"
     927        PRINT*, "Depart legerement fausse. Mais je continue"
     928        wake_deltaq=0.
     929      ELSE
     930        xmin = 1.0E+20
     931        xmax = -1.0E+20
     932        DO k = 1, klev
     933          DO i = 1, klon
     934            xmin = MIN(wake_deltaq(i,k),xmin)
     935            xmax = MAX(wake_deltaq(i,k),xmax)
     936          ENDDO
     937        ENDDO
     938        PRINT*,'wake_deltaq:', xmin, xmax
    1584939      ENDIF
    1585940c
    1586941c wake_s
    1587942c
    1588       ierr = NF_INQ_VARID (nid, "WAKE_S", nvarid)
    1589       IF (ierr.NE.NF_NOERR) THEN
    1590          PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
    1591          PRINT*, "Depart legerement fausse. Mais je continue"
    1592          wake_s_glo=0.
    1593       ELSE
    1594 #ifdef NC_DOUBLE
    1595          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_s_glo)
    1596 #else
    1597          ierr = NF_GET_VAR_REAL(nid, nvarid, wake_s_glo)
    1598 #endif
    1599          IF (ierr.NE.NF_NOERR) THEN
    1600             PRINT*, "phyetat0: Lecture echouee pour <WAKE_S>"
    1601             CALL abort
    1602          ENDIF
    1603       ENDIF
    1604       xmin = 1.0E+20
    1605       xmax = -1.0E+20
    1606       xmin = MINval(wake_s_glo)
    1607       xmax = MAXval(wake_s_glo)
     943      CALL get_field("WAKE_S",wake_s,found)
     944      IF (.NOT. found) THEN
     945        PRINT*, "phyetat0: Le champ <WAKE_S> est absent"
     946        PRINT*, "Depart legerement fausse. Mais je continue"
     947        wake_s=0.
     948      ENDIF
     949      xmin = 1.0E+20
     950      xmax = -1.0E+20
     951      xmin = MINval(wake_s)
     952      xmax = MAXval(wake_s)
    1608953      PRINT*,'(ecart-type) wake_s:', xmin, xmax
    1609954c
    1610955c wake_cstar
    1611956c
    1612       ierr = NF_INQ_VARID (nid, "WAKE_CSTAR", nvarid)
    1613       IF (ierr.NE.NF_NOERR) THEN
     957      CALL get_field("WAKE_CSTAR",wake_cstar,found)
     958      IF (.NOT. found) THEN
    1614959         PRINT*, "phyetat0: Le champ <WAKE_CSTAR> est absent"
    1615960         PRINT*, "Depart legerement fausse. Mais je continue"
    1616          wake_cstar_glo=0.
    1617       ELSE
    1618 #ifdef NC_DOUBLE
    1619          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_cstar_glo)
    1620 #else
    1621          ierr = NF_GET_VAR_REAL(nid, nvarid, wake_cstar_glo)
    1622 #endif
    1623          IF (ierr.NE.NF_NOERR) THEN
    1624             PRINT*, "phyetat0: Lecture echouee pour <WAKE_CSTAR>"
    1625             CALL abort
    1626          ENDIF
    1627       ENDIF
    1628       xmin = 1.0E+20
    1629       xmax = -1.0E+20
    1630       xmin = MINval(wake_cstar_glo)
    1631       xmax = MAXval(wake_cstar_glo)
     961         wake_cstar=0.
     962      ENDIF
     963      xmin = 1.0E+20
     964      xmax = -1.0E+20
     965      xmin = MINval(wake_cstar)
     966      xmax = MAXval(wake_cstar)
    1632967      PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
    1633968c
    1634969c wake_fip
    1635970c
    1636       ierr = NF_INQ_VARID (nid, "WAKE_FIP", nvarid)
    1637       IF (ierr.NE.NF_NOERR) THEN
     971      CALL get_field("WAKE_FIP",wake_fip,found)
     972      IF (.NOT. found) THEN
    1638973         PRINT*, "phyetat0: Le champ <WAKE_FIP> est absent"
    1639974         PRINT*, "Depart legerement fausse. Mais je continue"
    1640          wake_fip_glo=0.
    1641       ELSE
    1642 #ifdef NC_DOUBLE
    1643          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_fip_glo)
    1644 #else
    1645          ierr = NF_GET_VAR_REAL(nid, nvarid, wake_fip_glo)
    1646 #endif
    1647          IF (ierr.NE.NF_NOERR) THEN
    1648             PRINT*, "phyetat0: Lecture echouee pour <WAKE_FIP>"
    1649             CALL abort
    1650          ENDIF
    1651       ENDIF
    1652       xmin = 1.0E+20
    1653       xmax = -1.0E+20
    1654       xmin = MINval(wake_fip_glo)
    1655       xmax = MAXval(wake_fip_glo)
     975         wake_fip=0.
     976      ENDIF
     977      xmin = 1.0E+20
     978      xmax = -1.0E+20
     979      xmin = MINval(wake_fip)
     980      xmax = MAXval(wake_fip)
    1656981      PRINT*,'(ecart-type) wake_fip:', xmin, xmax
    1657982c
    1658 c Fermer le fichier:
    1659 c
    1660       ierr = NF_CLOSE(nid)
    1661       ENDIF ! is_mpi_root .AND. is_omp_root
    1662 c
    1663 
    1664 c$OMP MASTER
    1665 cym  en attendant mieux
    1666         iolat(1)=rlat_glo(1)
    1667 
    1668 !FH1D   
    1669 !iolat(jjm+1)=rlat(klon_glo)
    1670         iolat(jjm+1-1/iim)=rlat_glo(klon_glo)
    1671         if (iim.gt.1) then
    1672         do i=2,jjm
    1673           iolat(i)=rlat_glo(2+(i-2)*iim)
    1674         enddo
    1675         endif
    1676 
    1677         CALL bcast_mpi(iolat)
    1678         CALL bcast_mpi(rlon_glo)
    1679 
    1680 !FH1D
    1681 !       call init_iophy(iolat,rlon(2:iim+1))
    1682         call init_iophy(iolat,rlon_glo(2-1/iim:iim+1-1/iim))
    1683        
    1684 c$OMP END MASTER
     983
     984c on ferme le fichier
     985      CALL close_startphy
     986
     987      CALL init_iophy_new(rlat,rlon)
    1685988       
    1686       call Scatter( rlat_glo,rlat)
    1687       call Scatter( rlon_glo,rlon)
    1688       call Scatter( tsol_glo,ftsol)
    1689       IF (iflag_pbl>1) then
    1690          call Scatter( pbl_tke_glo,pbl_tke)
    1691       endif
    1692       call Scatter( zmax0_glo,zmax0)
    1693       call Scatter( f0_glo,f0)
    1694       call Scatter( ema_work1_glo, ema_work1)
    1695       call Scatter( ema_work2_glo, ema_work2)
    1696       call Scatter( wake_deltat_glo, wake_deltat)
    1697       call Scatter( wake_deltaq_glo, wake_deltaq)
    1698       call Scatter( wake_s_glo, wake_s)
    1699       call Scatter( wake_cstar_glo, wake_cstar)
    1700       call Scatter( wake_fip_glo, wake_fip)
    1701       call Scatter( tsoil,tsoil_p)
    1702       call Scatter( qsurf,qsurf_p)
    1703       call Scatter( qsol,qsol_p)
    1704       call Scatter( snow,snow_p)
    1705       call Scatter( alb1_glo,falb1)
    1706       call Scatter( alb2_glo,falb2)
    1707       call Scatter( evap,evap_p)
    1708       call Scatter( radsol_glo,radsol)
    1709       call Scatter( rain_fall_glo,rain_fall)
    1710       call Scatter( snow_fall_glo,snow_fall)
    1711       call Scatter( sollw_glo,sollw)
    1712       call Scatter( solsw_glo,solsw)
    1713       call Scatter( fder,fder_p)
    1714       call Scatter( frugs,frugs_p)
    1715       call Scatter( agesno,agesno_p)
    1716       call Scatter( zmea_glo,zmea)
    1717       call Scatter( zstd_glo,zstd)
    1718       call Scatter( zsig_glo,zsig)
    1719       call Scatter( zgam_glo,zgam)
    1720       call Scatter( zthe_glo,zthe)
    1721       call Scatter( zpic_glo,zpic)
    1722       call Scatter( zval_glo,zval)
    1723       call Scatter( rugsrel_glo,rugoro)
    1724       call Scatter( pctsrf_glo,pctsrf)
    1725       call Scatter( run_off_lic_0,run_off_lic_0_p)
    1726       call Scatter( t_ancien_glo,t_ancien)
    1727       call Scatter( q_ancien_glo,q_ancien)
    1728       call Scatter( rnebcon_glo,rnebcon)
    1729       call Scatter( clwcon_glo,clwcon)
    1730       call Scatter( ratqs_glo,ratqs)
    1731       call Scatter( zmasq_glo,zmasq)
    1732989
    1733990c
    1734991c Initialize module pbl_surface_mod
    1735992c
    1736       CALL pbl_surface_init(qsol_p, fder_p, snow_p, qsurf_p,
    1737      $     evap_p, frugs_p, agesno_p, tsoil_p)
     993      CALL pbl_surface_init(qsol, fder, snow, qsurf,
     994     $     evap, frugs, agesno, tsoil)
    1738995
    1739996c Initialize module ocean_cpl_mod for the case of coupled ocean
    … …  
    17441001c Initilialize module fonte_neige_mod     
    17451002c
    1746       CALL fonte_neige_init(run_off_lic_0_p)
    1747 
     1003      CALL fonte_neige_init(run_off_lic_0)
    17481004
    17491005      RETURN

  • LMDZ4/trunk/libf/phylmd/phyredem.F

    r996 r1001  
    1111      USE pbl_surface_mod,  ONLY : pbl_surface_final
    1212      USE phys_state_var_mod
     13      USE iostart
    1314
    1415      IMPLICIT none
    … …  
    2930
    3031c les variables globales ecrites dans le fichier restart
    31       REAL rlat_glo(klon_glo), rlon_glo(klon_glo)
    32       REAL pctsrf_glo(klon_glo, nbsrf)
    33       REAL tsol_glo(klon_glo,nbsrf)
    34       REAL alb1_glo(klon_glo,nbsrf)
    35       REAL alb2_glo(klon_glo,nbsrf)
    36       REAL rain_fall_glo(klon_glo)
    37       REAL snow_fall_glo(klon_glo)
    38       real solsw_glo(klon_glo)
    39       real sollw_glo(klon_glo)
    40       REAL radsol_glo(klon_glo)
    41       REAL zmea_glo(klon_glo)
    42       REAL zstd_glo(klon_glo)
    43       REAL zsig_glo(klon_glo)
    44       REAL zgam_glo(klon_glo)
    45       REAL zthe_glo(klon_glo)
    46       REAL zpic_glo(klon_glo)
    47       REAL zval_glo(klon_glo)
    48       REAL rugsrel_glo(klon_glo)
    49       REAL t_ancien_glo(klon_glo,klev), q_ancien_glo(klon_glo,klev)
    50       REAL clwcon_glo(klon_glo,klev)
    51       REAL rnebcon_glo(klon_glo,klev)
    52       REAL ratqs_glo(klon_glo,klev)
    53       REAL pbl_tke_glo(klon_glo,klev+1,nbsrf)
    54       REAL zmax0_glo(klon_glo), f0_glo(klon)
    55       REAL ema_work1_glo(klon_glo, klev), ema_work2_glo(klon_glo, klev)
    56       REAL wake_deltat_glo(klon_glo,klev),wake_deltaq_glo(klon_glo,klev)
    57       REAL wake_s_glo(klon_glo), wake_cstar_glo(klon_glo)
    58       REAL wake_fip_glo(klon_glo)
    59 
    60       REAL tsoil_p(klon,nsoilmx,nbsrf)
    61       REAL qsurf_p(klon,nbsrf)
    62       REAL qsol_p(klon)
    63       REAL snow_p(klon,nbsrf)
    64       REAL evap_p(klon,nbsrf)
    65       real fder_p(klon)
    66       REAL frugs_p(klon,nbsrf)
    67       REAL agesno_p(klon,nbsrf)
    68       REAL run_off_lic_0_p(klon)
    69      
    70       REAL tsoil(klon_glo,nsoilmx,nbsrf)
    71       REAL qsurf(klon_glo,nbsrf)
    72       REAL qsol(klon_glo)
    73       REAL snow(klon_glo,nbsrf)
    74       REAL evap(klon_glo,nbsrf)
    75       real fder(klon_glo)
    76       REAL frugs(klon_glo,nbsrf)
    77       REAL agesno(klon_glo,nbsrf)
    78       REAL run_off_lic_0(klon_glo)
    79       REAL masq(klon_glo)
     32
     33     
     34      REAL tsoil(klon,nsoilmx,nbsrf)
     35      REAL tslab(klon), seaice(klon)
     36      REAL qsurf(klon,nbsrf)
     37      REAL qsol(klon)
     38      REAL snow(klon,nbsrf)
     39      REAL evap(klon,nbsrf)
     40      real fder(klon)
     41      REAL frugs(klon,nbsrf)
     42      REAL agesno(klon,nbsrf)
     43      REAL run_off_lic_0(klon)
    8044c
    8145      INTEGER nid, nvarid, idim1, idim2, idim3
    … …  
    9357c Get variables which will be written to restart file from module
    9458c pbl_surface_mod
    95       CALL pbl_surface_final(qsol_p, fder_p, snow_p, qsurf_p,
    96      $     evap_p, frugs_p, agesno_p, tsoil_p)
     59      CALL pbl_surface_final(qsol, fder, snow, qsurf,
     60     $     evap, frugs, agesno, tsoil)
    9761
    9862c Get a variable calculated in module fonte_neige_mod
    99       CALL fonte_neige_final(run_off_lic_0_p)
    100 
    101 c======================================================================
    102 
    103       call Gather( rlat,rlat_glo)
    104       call Gather( rlon,rlon_glo)
    105       call Gather( pctsrf,pctsrf_glo)
    106       call Gather( ftsol,tsol_glo)
    107       call Gather( falb1,alb1_glo)
    108       call Gather( falb2,alb2_glo)
    109       call Gather( rain_fall,rain_fall_glo)
    110       call Gather( snow_fall,snow_fall_glo)
    111       call Gather( sollw,sollw_glo)
    112       call Gather( solsw,solsw_glo)
    113       call Gather( radsol,radsol_glo)
    114       call Gather( zmea,zmea_glo)
    115       call Gather( zstd,zstd_glo)
    116       call Gather( zsig,zsig_glo)
    117       call Gather( zgam,zgam_glo)
    118       call Gather( zthe,zthe_glo)
    119       call Gather( zpic,zpic_glo)
    120       call Gather( zval,zval_glo)
    121       call Gather( rugoro,rugsrel_glo)
    122       call Gather( t_ancien,t_ancien_glo)
    123       call Gather( q_ancien,q_ancien_glo)
    124       call Gather( clwcon,clwcon_glo)
    125       call Gather( rnebcon,rnebcon_glo)
    126       call Gather( ratqs,ratqs_glo)
    127       call Gather( pbl_tke,pbl_tke_glo)
    128       call Gather( zmax0,zmax0_glo)
    129       call Gather( f0,f0_glo)
    130       call Gather( ema_work1, ema_work1_glo)
    131       call Gather( ema_work2, ema_work2_glo)
    132       call Gather( wake_deltat, wake_deltat_glo)
    133       call Gather( wake_deltaq, wake_deltaq_glo)
    134       call Gather( wake_s, wake_s_glo)
    135       call Gather( wake_cstar, wake_cstar_glo)
    136       call Gather( wake_fip, wake_fip_glo)
    137 
    138       call Gather( tsoil_p,tsoil)
    139       call Gather( qsurf_p,qsurf)
    140       call Gather( qsol_p,qsol)
    141       call Gather( snow_p,snow)
    142       call Gather( evap_p,evap)
    143       call Gather( fder_p,fder)
    144       call Gather( frugs_p,frugs)
    145       call Gather( agesno_p,agesno)
    146       call Gather( run_off_lic_0_p,run_off_lic_0)
    147       call Gather( zmasq,masq)
    148      
    149 c$OMP MASTER
    150       IF (is_mpi_root) THEN
    151      
    152       ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
    153       IF (ierr.NE.NF_NOERR) THEN
    154         write(6,*)' Pb d''ouverture du fichier '//fichnom
    155         write(6,*)' ierr = ', ierr
    156         CALL ABORT
    157       ENDIF
    158 c
    159       ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
    160      .                       "Fichier redemmarage physique")
    161 c
    162       ierr = NF_DEF_DIM (nid, "index", length, idim1)
    163       ierr = NF_DEF_DIM (nid, "points_physiques", klon_glo, idim2)
    164       ierr = NF_DEF_DIM (nid, "horizon_vertical", klon_glo*klev, idim3)
    165 c
    166       ierr = NF_ENDDEF(nid)
    167 c
     63      CALL fonte_neige_final(run_off_lic_0)
     64
     65c======================================================================
     66
     67      CALL open_restartphy(fichnom)
     68     
    16869      DO ierr = 1, length
    16970         tab_cntrl(ierr) = 0.0
    … …  
    18687      tab_cntrl(15) = itau_phy
    18788c
    188       ierr = NF_REDEF (nid)
    189 #ifdef NC_DOUBLE
    190       ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
    191 #else
    192       ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
    193 #endif
    194       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
    195      .                        "Parametres de controle")
    196       ierr = NF_ENDDEF(nid)
    197 #ifdef NC_DOUBLE
    198       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
    199 #else
    200       ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
    201 #endif
    202 c
    203       ierr = NF_REDEF (nid)
    204 #ifdef NC_DOUBLE
    205       ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
    206 #else
    207       ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
    208 #endif
    209       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
    210      .                        "Longitudes de la grille physique")
    211       ierr = NF_ENDDEF(nid)
    212 #ifdef NC_DOUBLE
    213       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon_glo)
    214 #else
    215       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon_glo)
    216 #endif
    217 c
    218       ierr = NF_REDEF (nid)
    219 #ifdef NC_DOUBLE
    220       ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
    221 #else
    222       ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
    223 #endif
    224       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
    225      .                        "Latitudes de la grille physique")
    226       ierr = NF_ENDDEF(nid)
    227 #ifdef NC_DOUBLE
    228       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat_glo)
    229 #else
    230       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat_glo)
    231 #endif
     89      CALL put_var("controle","Parametres de controle",tab_cntrl)
     90c
     91
     92      CALL put_field("longitude",
     93     .               "Longitudes de la grille physique",rlon)
     94     
     95      CALL put_field("latitude","Latitudes de la grille physique",rlat)
     96
    23297c
    23398C PB ajout du masque terre/mer
    23499C
    235       ierr = NF_REDEF (nid)
    236 #ifdef NC_DOUBLE
    237       ierr = NF_DEF_VAR (nid, "masque", NF_DOUBLE, 1, idim2,nvarid)
    238 #else
    239       ierr = NF_DEF_VAR (nid, "masque", NF_FLOAT, 1, idim2,nvarid)
    240 #endif
    241       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 16,
    242      .                        "masque terre mer")
    243       ierr = NF_ENDDEF(nid)
    244 #ifdef NC_DOUBLE
    245       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masq)
    246 #else
    247       ierr = NF_PUT_VAR_REAL (nid,nvarid,masq)
    248 #endif     
     100      CALL put_field("masque","masque terre mer",zmasq)
     101
    249102c BP ajout des fraction de chaque sous-surface
    250103C
    251104C 1. fraction de terre
    252105C
    253       ierr = NF_REDEF (nid)
    254 #ifdef NC_DOUBLE
    255       ierr = NF_DEF_VAR (nid, "FTER", NF_DOUBLE, 1, idim2,nvarid)
    256 #else
    257       ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 1, idim2,nvarid)
    258 #endif
    259       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
    260      .                        "fraction de continent")
    261       ierr = NF_ENDDEF(nid)
    262 #ifdef NC_DOUBLE
    263       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,     &
    264      &   is_ter))
    265 #else
    266       ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,       &
    267      &    is_ter))
    268 #endif
     106      CALL put_field("FTER","fraction de continent",pctsrf(:,is_ter))
    269107C
    270108C 2. Fraction de glace de terre
    271109C
    272       ierr = NF_REDEF (nid)
    273 #ifdef NC_DOUBLE
    274       ierr = NF_DEF_VAR (nid, "FLIC", NF_DOUBLE, 1, idim2,nvarid)
    275 #else
    276       ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 1, idim2,nvarid)
    277 #endif
    278       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
    279      .                        "fraction glace de terre")
    280       ierr = NF_ENDDEF(nid)
    281 #ifdef NC_DOUBLE
    282       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,
    283      &                          is_lic))
    284 #else
    285       ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,
    286      &                        is_lic))
    287 #endif
     110      CALL put_field("FLIC","fraction glace de terre",pctsrf(:,is_lic))
    288111C
    289112C 3. fraction ocean
    290113C
    291       ierr = NF_REDEF (nid)
    292 #ifdef NC_DOUBLE
    293       ierr = NF_DEF_VAR (nid, "FOCE", NF_DOUBLE, 1, idim2,nvarid)
    294 #else
    295       ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 1, idim2,nvarid)
    296 #endif
    297       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
    298      .                        "fraction ocean")
    299       ierr = NF_ENDDEF(nid)
    300 #ifdef NC_DOUBLE
    301       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,
    302      &                          is_oce))
    303 #else
    304       ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,
    305      &                        is_oce))
    306 #endif
     114      CALL put_field("FOCE","fraction ocean",pctsrf(:,is_oce))
    307115C
    308116C 4. Fraction glace de mer
    309117C
    310       ierr = NF_REDEF (nid)
    311 #ifdef NC_DOUBLE
    312       ierr = NF_DEF_VAR (nid, "FSIC", NF_DOUBLE, 1, idim2,nvarid)
    313 #else
    314       ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 1, idim2,nvarid)
    315 #endif
    316       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
    317      .                        "fraction glace mer")
    318       ierr = NF_ENDDEF(nid)
    319 #ifdef NC_DOUBLE
    320       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pctsrf_glo(1 : klon_glo,
    321      &                          is_sic))
    322 #else
    323       ierr = NF_PUT_VAR_REAL (nid,nvarid,pctsrf_glo(1 : klon_glo,
    324      &                         is_sic))
    325 #endif
    326 C
    327 C
     118      CALL put_field("FSIC","fraction glace mer",pctsrf(:,is_sic))
     119C
     120C
     121c
     122      DO nsrf = 1, nbsrf
     123        IF (nsrf.LE.99) THEN
     124          WRITE(str2,'(i2.2)') nsrf
     125          CALL put_field("TS"//str2,"Temperature de surface No."//str2,
     126     .                    ftsol(:,nsrf))
     127        ELSE
     128          PRINT*, "Trop de sous-mailles"
     129          CALL abort
     130        ENDIF
     131      ENDDO
     132c
     133      DO nsrf = 1, nbsrf
     134        DO isoil=1, nsoilmx
     135          IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
     136            WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
     137            CALL put_field("Tsoil"//str7,"Temperature du sol No."//str7,
     138     .                     tsoil(:,isoil,nsrf))
     139          ELSE
     140            PRINT*, "Trop de couches"
     141            CALL abort
     142          ENDIF
     143        ENDDO
     144      ENDDO
     145c
     146      DO nsrf = 1, nbsrf
     147        IF (nsrf.LE.99) THEN
     148          WRITE(str2,'(i2.2)') nsrf
     149          CALL put_field("QS"//str2,"Humidite de surface No."//str2,
     150     .                   qsurf(:,nsrf))
     151        ELSE
     152          PRINT*, "Trop de sous-mailles"
     153          CALL abort
     154        ENDIF
     155      END DO
     156C
     157      CALL put_field("QSOL","Eau dans le sol (mm)",qsol)
     158c
     159      DO nsrf = 1, nbsrf
     160        IF (nsrf.LE.99) THEN
     161          WRITE(str2,'(i2.2)') nsrf
     162          CALL put_field("ALBE"//str2,"albedo de surface No."//str2,
     163     .                   falb1(:,nsrf))
     164        ELSE
     165          PRINT*, "Trop de sous-mailles"
     166          CALL abort
     167        ENDIF
     168      ENDDO
     169
     170      DO nsrf = 1, nbsrf
     171        IF (nsrf.LE.99) THEN
     172          WRITE(str2,'(i2.2)') nsrf
     173          CALL put_field("ALBLW"//str2,"albedo LW de surface No."//str2,
     174     .                   falb2(:,nsrf))
     175        ELSE
     176          PRINT*, "Trop de sous-mailles"
     177          CALL abort
     178        ENDIF
     179      ENDDO
     180c
     181c
     182      DO nsrf = 1, nbsrf
     183        IF (nsrf.LE.99) THEN
     184          WRITE(str2,'(i2.2)') nsrf
     185          CALL put_field("EVAP"//str2,"Evaporation de surface No."//str2
     186     .                   ,evap(:,nsrf))
     187        ELSE
     188          PRINT*, "Trop de sous-mailles"
     189          CALL abort
     190        ENDIF
     191      ENDDO
     192
     193c
     194      DO nsrf = 1, nbsrf
     195        IF (nsrf.LE.99) THEN
     196          WRITE(str2,'(i2.2)') nsrf
     197          CALL put_field("SNOW"//str2,"Neige de surface No."//str2,
     198     .                   snow(:,nsrf))
     199        ELSE
     200          PRINT*, "Trop de sous-mailles"
     201          CALL abort
     202        ENDIF
     203      ENDDO
     204
     205c
     206      CALL put_field("RADS","Rayonnement net a la surface",radsol)
     207c
     208      CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
     209c
     210      CALL put_field("sollw","Rayonnement IF a la surface",sollw)
     211c
     212      CALL put_field("fder","Derive de flux",fder)
     213c
     214      CALL put_field("rain_f","precipitation liquide",rain_fall)
     215c
     216      CALL put_field("snow_f", "precipitation solide",snow_fall)
    328217c
    329218      DO nsrf = 1, nbsrf
    330219        IF (nsrf.LE.99) THEN
    331220        WRITE(str2,'(i2.2)') nsrf
    332         ierr = NF_REDEF (nid)
    333 #ifdef NC_DOUBLE
    334         ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid)
    335 #else
    336         ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid)
    337 #endif
    338         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    339      .                        "Temperature de surface No."//str2)
    340         ierr = NF_ENDDEF(nid)
    341         ELSE
    342         PRINT*, "Trop de sous-mailles"
    343         CALL abort
    344         ENDIF
    345 #ifdef NC_DOUBLE
    346         ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol_glo(1,nsrf))
    347 #else
    348         ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol_glo(1,nsrf))
    349 #endif
    350       ENDDO
    351 c
    352       DO nsrf = 1, nbsrf
    353       DO isoil=1, nsoilmx
    354         IF (isoil.LE.99 .AND. nsrf.LE.99) THEN
    355         WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf
    356         ierr = NF_REDEF (nid)
    357 #ifdef NC_DOUBLE
    358         ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid)
    359 #else
    360         ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid)
    361 #endif
    362         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29,
    363      .                        "Temperature du sol No."//str7)
    364         ierr = NF_ENDDEF(nid)
    365         ELSE
    366         PRINT*, "Trop de couches"
    367         CALL abort
    368         ENDIF
    369 #ifdef NC_DOUBLE
    370         ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf))
    371 #else
    372         ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf))
    373 #endif
    374       ENDDO
    375       ENDDO
    376 c
    377       DO nsrf = 1, nbsrf
    378         IF (nsrf.LE.99) THEN
    379         WRITE(str2,'(i2.2)') nsrf
    380         ierr = NF_REDEF (nid)
    381 #ifdef NC_DOUBLE
    382         ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid)
    383 #else
    384         ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid)
    385 #endif
    386         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
    387      .                        "Humidite de surface No."//str2)
    388         ierr = NF_ENDDEF(nid)
    389         ELSE
    390         PRINT*, "Trop de sous-mailles"
    391         CALL abort
    392         ENDIF
    393 #ifdef NC_DOUBLE
    394       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsurf(1,nsrf))
    395 #else
    396       ierr = NF_PUT_VAR_REAL (nid,nvarid,qsurf(1,nsrf))
    397 #endif
    398       END DO
    399 C
    400       ierr = NF_REDEF (nid)
    401 #ifdef NC_DOUBLE
    402       ierr = NF_DEF_VAR (nid,"QSOL",NF_DOUBLE,1,idim2,nvarid)
    403 #else
    404       ierr = NF_DEF_VAR (nid,"QSOL",NF_FLOAT,1,idim2,nvarid)
    405 #endif
    406       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
    407      .    "Eau dans le sol (mm)")
    408       ierr = NF_ENDDEF(nid)
    409 #ifdef NC_DOUBLE
    410       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol)
    411 #else
    412       ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol)
    413 #endif
    414 c
    415       DO nsrf = 1, nbsrf
    416         IF (nsrf.LE.99) THEN
    417         WRITE(str2,'(i2.2)') nsrf
    418         ierr = NF_REDEF (nid)
    419 #ifdef NC_DOUBLE
    420         ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_DOUBLE,1,idim2,nvarid)
    421 #else
    422         ierr = NF_DEF_VAR (nid,"ALBE"//str2,NF_FLOAT,1,idim2,nvarid)
    423 #endif
    424         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
    425      .                        "albedo de surface No."//str2)
    426         ierr = NF_ENDDEF(nid)
    427         ELSE
    428         PRINT*, "Trop de sous-mailles"
    429         CALL abort
    430         ENDIF
    431 #ifdef NC_DOUBLE
    432       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb1_glo(1,nsrf))
    433 #else
    434       ierr = NF_PUT_VAR_REAL (nid,nvarid,alb1_glo(1,nsrf))
    435 #endif
    436       ENDDO
    437 
    438         DO nsrf = 1, nbsrf
    439         IF (nsrf.LE.99) THEN
    440         WRITE(str2,'(i2.2)') nsrf
    441         ierr = NF_REDEF (nid)
    442 #ifdef NC_DOUBLE
    443         ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_DOUBLE,1,idim2,nvarid)
    444 #else
    445         ierr = NF_DEF_VAR (nid,"ALBLW"//str2,NF_FLOAT,1,idim2,nvarid)
    446 #endif
    447         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
    448      .                        "albedo LW de surface No."//str2)
    449         ierr = NF_ENDDEF(nid)
    450         ELSE
    451         PRINT*, "Trop de sous-mailles"
    452         CALL abort
    453         ENDIF
    454 #ifdef NC_DOUBLE
    455       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,alb2_glo(1,nsrf))
    456 #else
    457       ierr = NF_PUT_VAR_REAL (nid,nvarid,alb2_glo(1,nsrf))
    458 #endif
    459       ENDDO
    460 c
    461 c
    462       DO nsrf = 1, nbsrf
    463         IF (nsrf.LE.99) THEN
    464         WRITE(str2,'(i2.2)') nsrf
    465         ierr = NF_REDEF (nid)
    466 #ifdef NC_DOUBLE
    467         ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_DOUBLE,1,idim2,nvarid)
    468 #else
    469         ierr = NF_DEF_VAR (nid,"EVAP"//str2,NF_FLOAT,1,idim2,nvarid)
    470 #endif
    471         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    472      .                        "Evaporation de surface No."//str2)
    473         ierr = NF_ENDDEF(nid)
    474         ELSE
    475         PRINT*, "Trop de sous-mailles"
    476         CALL abort
    477         ENDIF
    478 #ifdef NC_DOUBLE
    479       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,evap(1,nsrf))
    480 #else
    481       ierr = NF_PUT_VAR_REAL (nid,nvarid,evap(1,nsrf))
    482 #endif
    483       ENDDO
    484 
    485 c
    486       DO nsrf = 1, nbsrf
    487         IF (nsrf.LE.99) THEN
    488         WRITE(str2,'(i2.2)') nsrf
    489         ierr = NF_REDEF (nid)
    490 #ifdef NC_DOUBLE
    491         ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid)
    492 #else
    493         ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid)
    494 #endif
    495         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
    496      .                        "Neige de surface No."//str2)
    497         ierr = NF_ENDDEF(nid)
    498         ELSE
    499         PRINT*, "Trop de sous-mailles"
    500         CALL abort
    501         ENDIF
    502 #ifdef NC_DOUBLE
    503       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf))
    504 #else
    505       ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf))
    506 #endif
    507       ENDDO
    508 
    509 c
    510       ierr = NF_REDEF (nid)
    511 #ifdef NC_DOUBLE
    512       ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
    513 #else
    514       ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
    515 #endif
    516       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    517      .                        "Rayonnement net a la surface")
    518       ierr = NF_ENDDEF(nid)
    519 #ifdef NC_DOUBLE
    520       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol_glo)
    521 #else
    522       ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol_glo)
    523 #endif
    524 c
    525       ierr = NF_REDEF (nid)
    526 #ifdef NC_DOUBLE
    527       ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
    528 #else
    529       ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
    530 #endif
    531       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
    532      .                        "Rayonnement solaire a la surface")
    533       ierr = NF_ENDDEF(nid)
    534 #ifdef NC_DOUBLE
    535       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw_glo)
    536 #else
    537       ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw_glo)
    538 #endif
    539 c
    540       ierr = NF_REDEF (nid)
    541 #ifdef NC_DOUBLE
    542       ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
    543 #else
    544       ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
    545 #endif
    546       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
    547      .                        "Rayonnement IF a la surface")
    548       ierr = NF_ENDDEF(nid)
    549 #ifdef NC_DOUBLE
    550       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw_glo)
    551 #else
    552       ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw_glo)
    553 #endif
    554 c
    555       ierr = NF_REDEF (nid)
    556 #ifdef NC_DOUBLE
    557       ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
    558 #else
    559       ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
    560 #endif
    561       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
    562      .                        "Derive de flux")
    563       ierr = NF_ENDDEF(nid)
    564 #ifdef NC_DOUBLE
    565       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
    566 #else
    567       ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
    568 #endif
    569 c
    570       ierr = NF_REDEF (nid)
    571 #ifdef NC_DOUBLE
    572       ierr = NF_DEF_VAR (nid, "rain_f", NF_DOUBLE, 1, idim2,nvarid)
    573 #else
    574       ierr = NF_DEF_VAR (nid, "rain_f", NF_FLOAT, 1, idim2,nvarid)
    575 #endif
    576       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
    577      .                        "precipitation liquide")
    578       ierr = NF_ENDDEF(nid)
    579 #ifdef NC_DOUBLE
    580       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rain_fall_glo)
    581 #else
    582       ierr = NF_PUT_VAR_REAL (nid,nvarid,rain_fall_glo)
    583 #endif
    584 c
    585       ierr = NF_REDEF (nid)
    586 #ifdef NC_DOUBLE
    587       ierr = NF_DEF_VAR (nid, "snow_f", NF_DOUBLE, 1, idim2,nvarid)
    588 #else
    589       ierr = NF_DEF_VAR (nid, "snow_f", NF_FLOAT, 1, idim2,nvarid)
    590 #endif
    591       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
    592      .                        "precipitation solide")
    593       ierr = NF_ENDDEF(nid)
    594 #ifdef NC_DOUBLE
    595       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow_fall_glo)
    596 #else
    597       ierr = NF_PUT_VAR_REAL (nid,nvarid,snow_fall_glo)
    598 #endif
    599 c
    600        endif
    601 c$OMP END MASTER
    602 cc ----> necessaire pour eviter bug openMP sur SX6
    603 c$OMP MASTER
    604       if (is_mpi_root) then
    605       DO nsrf = 1, nbsrf
    606         IF (nsrf.LE.99) THEN
    607         WRITE(str2,'(i2.2)') nsrf
    608         ierr = NF_REDEF (nid)
    609 #ifdef NC_DOUBLE
    610         ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_DOUBLE,1,idim2,nvarid)
    611 #else
    612         ierr = NF_DEF_VAR (nid,"RUG"//str2,NF_FLOAT,1,idim2,nvarid)
    613 #endif
    614         ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 23,
    615      .                        "rugosite de surface No."//str2)
    616         ierr = NF_ENDDEF(nid)
    617         ELSE
    618         PRINT*, "Trop de sous-mailles"
    619         CALL abort
    620         ENDIF
    621 #ifdef NC_DOUBLE
    622       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,nsrf))
    623 #else
    624       ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,nsrf))
    625 #endif
     221          CALL put_field("RUG"//str2,"rugosite de surface No."//str2,
     222     .         frugs(:,nsrf))
     223        ELSE
     224          PRINT*, "Trop de sous-mailles"
     225          CALL abort
     226        ENDIF
    626227      ENDDO
    627228c
    … …  
    629230        IF (nsrf.LE.99) THEN
    630231            WRITE(str2,'(i2.2)') nsrf
    631             ierr = NF_REDEF (nid)
    632 #ifdef NC_DOUBLE
    633             ierr = NF_DEF_VAR (nid,"AGESNO"//str2,NF_DOUBLE,1,idim2
    634      $          ,nvarid)
    635 #else
    636             ierr = NF_DEF_VAR (nid,"AGESNO"//str2,NF_FLOAT,1,idim2
    637      $          ,nvarid)
    638 #endif
    639             ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
    640      .                        "Age de la neige surface No."//str2)
    641             ierr = NF_ENDDEF(nid)
     232            CALL put_field("AGESNO"//str2,
     233     .                     "Age de la neige surface No."//str2,
     234     .                     agesno(:,nsrf))
    642235        ELSE
    643236            PRINT*, "Trop de sous-mailles"
    644237            CALL abort
    645238        ENDIF
    646 #ifdef NC_DOUBLE
    647         ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno(1,nsrf))
    648 #else
    649       ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno(1,nsrf))
    650 #endif
    651       ENDDO
    652 c
    653       ierr = NF_REDEF (nid)
    654 #ifdef NC_DOUBLE
    655       ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
    656 #else
    657       ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
    658 #endif
    659       ierr = NF_ENDDEF(nid)
    660 #ifdef NC_DOUBLE
    661       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea_glo)
    662 #else
    663       ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea_glo)
    664 #endif
    665 c
    666       ierr = NF_REDEF (nid)
    667 #ifdef NC_DOUBLE
    668       ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
    669 #else
    670       ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
    671 #endif
    672       ierr = NF_ENDDEF(nid)
    673 #ifdef NC_DOUBLE
    674       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd_glo)
    675 #else
    676       ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd_glo)
    677 #endif
    678       ierr = NF_REDEF (nid)
    679 #ifdef NC_DOUBLE
    680       ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
    681 #else
    682       ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
    683 #endif
    684       ierr = NF_ENDDEF(nid)
    685 #ifdef NC_DOUBLE
    686       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig_glo)
    687 #else
    688       ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig_glo)
    689 #endif
    690       ierr = NF_REDEF (nid)
    691 #ifdef NC_DOUBLE
    692       ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
    693 #else
    694       ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
    695 #endif
    696       ierr = NF_ENDDEF(nid)
    697 #ifdef NC_DOUBLE
    698       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam_glo)
    699 #else
    700       ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam_glo)
    701 #endif
    702       ierr = NF_REDEF (nid)
    703 #ifdef NC_DOUBLE
    704       ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
    705 #else
    706       ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
    707 #endif
    708       ierr = NF_ENDDEF(nid)
    709 #ifdef NC_DOUBLE
    710       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe_glo)
    711 #else
    712       ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe_glo)
    713 #endif
    714       ierr = NF_REDEF (nid)
    715 #ifdef NC_DOUBLE
    716       ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
    717 #else
    718       ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
    719 #endif
    720       ierr = NF_ENDDEF(nid)
    721 #ifdef NC_DOUBLE
    722       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic_glo)
    723 #else
    724       ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic_glo)
    725 #endif
    726       ierr = NF_REDEF (nid)
    727 #ifdef NC_DOUBLE
    728       ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
    729 #else
    730       ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
    731 #endif
    732       ierr = NF_ENDDEF(nid)
    733 #ifdef NC_DOUBLE
    734       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval_glo)
    735 #else
    736       ierr = NF_PUT_VAR_REAL (nid,nvarid,zval_glo)
    737 #endif
    738       ierr = NF_REDEF (nid)
    739 #ifdef NC_DOUBLE
    740       ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
    741 #else
    742       ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
    743 #endif
    744       ierr = NF_ENDDEF(nid)
    745 #ifdef NC_DOUBLE
    746       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel_glo)
    747 #else
    748       ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel_glo)
    749 #endif
    750 c
    751       ierr = NF_REDEF (nid)
    752 #ifdef NC_DOUBLE
    753       ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
    754 #else
    755       ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
    756 #endif
    757       ierr = NF_ENDDEF(nid)
    758 #ifdef NC_DOUBLE
    759       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien_glo)
    760 #else
    761       ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien_glo)
    762 #endif
    763 c
    764       ierr = NF_REDEF (nid)
    765 #ifdef NC_DOUBLE
    766       ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
    767 #else
    768       ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
    769 #endif
    770       ierr = NF_ENDDEF(nid)
    771 #ifdef NC_DOUBLE
    772       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien_glo)
    773 #else
    774       ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien_glo)
    775 #endif
    776 c
    777       ierr = NF_REDEF (nid)
    778 #ifdef NC_DOUBLE
    779       ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
    780 #else
    781       ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
    782 #endif
    783       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    784      .                        "Longueur de rugosite sur mer")
    785       ierr = NF_ENDDEF(nid)
    786 #ifdef NC_DOUBLE
    787       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,frugs(1,is_oce))
    788 #else
    789       ierr = NF_PUT_VAR_REAL (nid,nvarid,frugs(1,is_oce))
    790 #endif
    791 c
    792       ierr = NF_REDEF (nid)
    793 #ifdef NC_DOUBLE
    794       ierr = NF_DEF_VAR (nid, "CLWCON", NF_DOUBLE, 1, idim2,nvarid)
    795 #else
    796       ierr = NF_DEF_VAR (nid, "CLWCON", NF_FLOAT, 1, idim2,nvarid)
    797 #endif
    798       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    799      .                        "Eau liquide convective")
    800       ierr = NF_ENDDEF(nid)
    801 #ifdef NC_DOUBLE
    802       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,clwcon_glo)
    803 #else
    804       ierr = NF_PUT_VAR_REAL (nid,nvarid,clwcon_glo)
    805 #endif
    806 c
    807       ierr = NF_REDEF (nid)
    808 #ifdef NC_DOUBLE
    809       ierr = NF_DEF_VAR (nid, "RNEBCON", NF_DOUBLE, 1, idim2,nvarid)
    810 #else
    811       ierr = NF_DEF_VAR (nid, "RNEBCON", NF_FLOAT, 1, idim2,nvarid)
    812 #endif
    813       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    814      .                        "Nebulosite convective")
    815       ierr = NF_ENDDEF(nid)
    816 #ifdef NC_DOUBLE
    817       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rnebcon_glo)
    818 #else
    819       ierr = NF_PUT_VAR_REAL (nid,nvarid,rnebcon_glo)
    820 #endif
    821 c
    822       ierr = NF_REDEF (nid)
    823 #ifdef NC_DOUBLE
    824       ierr = NF_DEF_VAR (nid, "RATQS", NF_DOUBLE, 1, idim2,nvarid)
    825 #else
    826       ierr = NF_DEF_VAR (nid, "RATQS", NF_FLOAT, 1, idim2,nvarid)
    827 #endif
    828       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
    829      .                        "Ratqs")
    830       ierr = NF_ENDDEF(nid)
    831 #ifdef NC_DOUBLE
    832       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ratqs_glo)
    833 #else
    834       ierr = NF_PUT_VAR_REAL (nid,nvarid,ratqs_glo)
    835 #endif
     239      ENDDO
     240c
     241      CALL put_field("ZMEA","",zmea)
     242c
     243      CALL put_field("ZSTD","",zstd)
     244     
     245      CALL put_field("ZSIG","",zsig)
     246     
     247      CALL put_field("ZGAM","",zgam)
     248     
     249      CALL put_field("ZTHE","",zthe)
     250     
     251      CALL put_field("ZPIC","",zpic)
     252     
     253      CALL put_field("ZVAL","",zval)
     254     
     255      CALL put_field("RUGSREL","RUGSREL",rugoro)
     256     
     257      CALL put_field("TANCIEN","",t_ancien)
     258     
     259      CALL put_field("QANCIEN","",q_ancien)
     260     
     261      CALL put_field("RUGMER","Longueur de rugosite sur mer",
     262     .               frugs(:,is_oce))
     263     
     264      CALL put_field("CLWCON","Eau liquide convective",clwcon(:,1))
     265     
     266      CALL put_field("RNEBCON","Nebulosite convective",rnebcon(:,1))
     267     
     268      CALL put_field("RATQS", "Ratqs",ratqs(:,1))
    836269c
    837270c run_off_lic_0
    838271c
    839       ierr = NF_REDEF (nid)
    840 #ifdef NC_DOUBLE
    841       ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_DOUBLE,1,idim2,nvarid)
    842 #else
    843       ierr=NF_DEF_VAR(nid,"RUNOFFLIC0",NF_FLOAT, 1,idim2,nvarid)
    844 #endif
    845       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 10,
    846      .                        "Runofflic0")
    847       ierr = NF_ENDDEF(nid)
    848 #ifdef NC_DOUBLE
    849       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,run_off_lic_0)
    850 #else
    851       ierr = NF_PUT_VAR_REAL (nid,nvarid,run_off_lic_0)
    852 #endif
     272      CALL put_field("RUNOFFLIC0","Runofflic0",run_off_lic_0)
    853273c
    854274c
    … …  
    856276c
    857277      IF (iflag_pbl>1) then
    858       DO nsrf = 1, nbsrf
    859         IF (nsrf.LE.99) THEN
     278        DO nsrf = 1, nbsrf
     279          IF (nsrf.LE.99) THEN
    860280            WRITE(str2,'(i2.2)') nsrf
    861             ierr = NF_REDEF (nid)
    862 #ifdef NC_DOUBLE
    863             ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_DOUBLE,1,idim3
    864      $          ,nvarid)
    865 #else
    866             ierr = NF_DEF_VAR (nid,"TKE"//str2,NF_FLOAT,1,idim3
    867      $          ,nvarid)
    868 #endif
    869             ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
    870      .                        "Energ. Cineti. Turb."//str2)
    871             ierr = NF_ENDDEF(nid)
    872         ELSE
     281            CALL put_field("TKE"//str2,"Energ. Cineti. Turb."//str2,
     282     .                     pbl_tke(:,1:klev,nsrf))
     283          ELSE
    873284            PRINT*, "Trop de sous-mailles"
    874285            CALL abort
    875         ENDIF
    876 #ifdef NC_DOUBLE
    877         ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pbl_tke_glo(:,:,nsrf))
    878 #else
    879       ierr = NF_PUT_VAR_REAL (nid,nvarid,pbl_tke_glo(:,:,nsrf))
    880 #endif
    881       ENDDO
     286          ENDIF
     287        ENDDO
    882288      ENDIF
    883289
    … …  
    885291cIM ajout zmax0, f0, ema_work1, ema_work2
    886292cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_fip
    887       ierr = NF_REDEF (nid)
    888 #ifdef NC_DOUBLE
    889       ierr = NF_DEF_VAR (nid, "ZMAX0", NF_DOUBLE, 1, idim2,nvarid)
    890 #else
    891       ierr = NF_DEF_VAR (nid, "ZMAX0", NF_FLOAT, 1, idim2,nvarid)
    892 #endif
    893       ierr = NF_ENDDEF(nid)
    894 #ifdef NC_DOUBLE
    895       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmax0_glo)
    896 #else
    897       ierr = NF_PUT_VAR_REAL (nid,nvarid,zmax0_glo)
    898 #endif
    899 c
    900       ierr = NF_REDEF (nid)
    901 #ifdef NC_DOUBLE
    902       ierr = NF_DEF_VAR (nid, "F0", NF_DOUBLE, 1, idim2,nvarid)
    903 #else
    904       ierr = NF_DEF_VAR (nid, "F0", NF_FLOAT, 1, idim2,nvarid)
    905 #endif
    906       ierr = NF_ENDDEF(nid)
    907 #ifdef NC_DOUBLE
    908       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,f0_glo)
    909 #else
    910       ierr = NF_PUT_VAR_REAL (nid,nvarid,f0_glo)
    911 #endif
    912 c ema_work1
    913       ierr = NF_REDEF (nid)
    914 #ifdef NC_DOUBLE
    915       ierr = NF_DEF_VAR (nid, "EMA_WORK1", NF_DOUBLE, 1, idim3,nvarid)
    916 #else
    917       ierr = NF_DEF_VAR (nid, "EMA_WORK1", NF_FLOAT, 1, idim3,nvarid)
    918 #endif
    919       ierr = NF_ENDDEF(nid)
    920 #ifdef NC_DOUBLE
    921       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ema_work1_glo)
    922 #else
    923       ierr = NF_PUT_VAR_REAL (nid,nvarid,ema_work1_glo)
    924 #endif
    925 c ema_work2
    926       ierr = NF_REDEF (nid)
    927 #ifdef NC_DOUBLE
    928       ierr = NF_DEF_VAR (nid, "EMA_WORK2", NF_DOUBLE, 1, idim3,nvarid)
    929 #else
    930       ierr = NF_DEF_VAR (nid, "EMA_WORK2", NF_FLOAT, 1, idim3,nvarid)
    931 #endif
    932       ierr = NF_ENDDEF(nid)
    933 #ifdef NC_DOUBLE
    934       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ema_work2_glo)
    935 #else
    936       ierr = NF_PUT_VAR_REAL (nid,nvarid,ema_work2_glo)
    937 #endif
     293     
     294      CALL put_field("ZMAX0","",zmax0)
     295     
     296      CALL put_field("F0","",f0)
     297     
     298      CALL put_field("EMA_WORK1","",ema_work1)
     299     
     300      CALL put_field("EMA_WORK2","",ema_work2)
     301     
    938302c wake_deltat
    939       ierr = NF_REDEF (nid)
    940 #ifdef NC_DOUBLE
    941       ierr = NF_DEF_VAR (nid, "WAKE_DELTAT", NF_DOUBLE, 1, idim3,nvarid)
    942 #else
    943       ierr = NF_DEF_VAR (nid, "WAKE_DELTAT", NF_FLOAT, 1, idim3,nvarid)
    944 #endif
    945       ierr = NF_ENDDEF(nid)
    946 #ifdef NC_DOUBLE
    947       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_deltat_glo)
    948 #else
    949       ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_deltat_glo)
    950 #endif
    951 c wake_deltaq
    952       ierr = NF_REDEF (nid)
    953 #ifdef NC_DOUBLE
    954       ierr = NF_DEF_VAR (nid, "WAKE_DELTAQ", NF_DOUBLE, 1, idim3,nvarid)
    955 #else
    956       ierr = NF_DEF_VAR (nid, "WAKE_DELTAQ", NF_FLOAT, 1, idim3,nvarid)
    957 #endif
    958       ierr = NF_ENDDEF(nid)
    959 #ifdef NC_DOUBLE
    960       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_deltaq_glo)
    961 #else
    962       ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_deltaq_glo)
    963 #endif
    964 c wake_s
    965       ierr = NF_REDEF (nid)
    966 #ifdef NC_DOUBLE
    967       ierr = NF_DEF_VAR (nid, "WAKE_S", NF_DOUBLE, 1, idim2,nvarid)
    968 #else
    969       ierr = NF_DEF_VAR (nid, "WAKE_S", NF_FLOAT, 1, idim2,nvarid)
    970 #endif
    971       ierr = NF_ENDDEF(nid)
    972 #ifdef NC_DOUBLE
    973       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_s_glo)
    974 #else
    975       ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_s_glo)
    976 #endif
    977 c wake_cstar
    978       ierr = NF_REDEF (nid)
    979 #ifdef NC_DOUBLE
    980       ierr = NF_DEF_VAR (nid, "WAKE_CSTAR", NF_DOUBLE, 1, idim2,nvarid)
    981 #else
    982       ierr = NF_DEF_VAR (nid, "WAKE_CSTAR", NF_FLOAT, 1, idim2,nvarid)
    983 #endif
    984       ierr = NF_ENDDEF(nid)
    985 #ifdef NC_DOUBLE
    986       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_cstar_glo)
    987 #else
    988       ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_cstar_glo)
    989 #endif
    990 c wake_fip
    991       ierr = NF_REDEF (nid)
    992 #ifdef NC_DOUBLE
    993       ierr = NF_DEF_VAR (nid, "WAKE_FIP", NF_DOUBLE, 1, idim2,nvarid)
    994 #else
    995       ierr = NF_DEF_VAR (nid, "WAKE_FIP", NF_FLOAT, 1, idim2,nvarid)
    996 #endif
    997       ierr = NF_ENDDEF(nid)
    998 #ifdef NC_DOUBLE
    999       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,wake_fip_glo)
    1000 #else
    1001       ierr = NF_PUT_VAR_REAL (nid,nvarid,wake_fip_glo)
    1002 #endif
    1003 c
    1004       ierr = NF_CLOSE(nid)
    1005 c
    1006       endif   ! is_mpi_root
    1007 c$OMP END MASTER
     303      CALL put_field("WAKE_DELTAT","",wake_deltat)
     304
     305      CALL put_field("WAKE_DELTAQ","",wake_deltaq)
     306     
     307      CALL put_field("WAKE_S","",wake_s)
     308     
     309      CALL put_field("WAKE_CSTAR","",wake_cstar)
     310     
     311      CALL put_field("WAKE_FIP","",wake_fip)
     312
     313      CALL close_restartphy
     314!$OMP BARRIER
    1008315      RETURN
    1009316      END

  • LMDZ4/trunk/libf/phylmd/phys_local_var_mod.F90

    r987 r1001  
    5151      REAL, SAVE, ALLOCATABLE :: d_u_lif(:,:), d_v_lif(:,:)
    5252      !$OMP THREADPRIVATE(d_u_lif, d_v_lif)
     53! Tendances Ondes de G non oro (runs strato).
     54      REAL, SAVE, ALLOCATABLE :: d_u_hin(:,:)
     55      !$OMP THREADPRIVATE(d_u_hin)
     56      REAL, SAVE, ALLOCATABLE :: d_v_hin(:,:)
     57      !$OMP THREADPRIVATE(d_v_hin)
     58      REAL, SAVE, ALLOCATABLE :: d_t_hin(:,:)
     59      !$OMP THREADPRIVATE(d_t_hin)
     60
    5361! tendance du a la conersion Ec -> E thermique
    5462      REAL, SAVE, ALLOCATABLE :: d_t_ec(:,:)

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r998 r1001  
    9494#include "clesphys.h"
    9595#include "control.h"
    96 #include "logic.h"
     96!#include "logic.h"
    9797#include "temps.h"
    9898cym#include "comgeomphy.h"
    … …  
    943943      REAL zustrli(klon), zvstrli(klon)
    944944      REAL zustrph(klon), zvstrph(klon)
     945      REAL zustrhi(klon), zvstrhi(klon)
    945946      REAL aam, torsfc
    946947cIM 141004 END
    … …  
    13771378!           ENDDO
    13781379!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1379 
    1380            CALL SUGWD(klon,klev,paprs,pplay)
     1380           IF (ok_strato) THEN
     1381             CALL SUGWD_strato(klon,klev,paprs,pplay)
     1382           ELSE
     1383             CALL SUGWD(klon,klev,paprs,pplay)
     1384           ENDIF
     1385           
    13811386           DO i=1,klon
    13821387             zuthe(i)=0.
    … …  
    29322937c        igwdim=MAX(1,igwd)
    29332938c
     2939        IF (ok_strato) THEN
     2940       
     2941          CALL drag_noro_strato(klon,klev,dtime,paprs,pplay,
     2942     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
     2943     e                   igwd,idx,itest,
     2944     e                   t_seri, u_seri, v_seri,
     2945     s                   zulow, zvlow, zustrdr, zvstrdr,
     2946     s                   d_t_oro, d_u_oro, d_v_oro)
     2947
     2948       ELSE
    29342949        CALL drag_noro(klon,klev,dtime,paprs,pplay,
    29352950     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
    29362951     e                   igwd,idx,itest,
    29372952     e                   t_seri, u_seri, v_seri,
    2938 cIM 141004    s                   zulow, zvlow, zustr, zvstr,
    29392953     s                   zulow, zvlow, zustrdr, zvstrdr,
    29402954     s                   d_t_oro, d_u_oro, d_v_oro)
     2955       ENDIF
    29412956c
    29422957c  ajout des tendances
    … …  
    29692984c        igwdim=MAX(1,igwd)
    29702985c
    2971         CALL lift_noro(klon,klev,dtime,paprs,pplay,
     2986        IF (ok_strato) THEN
     2987
     2988          CALL lift_noro_strato(klon,klev,dtime,paprs,pplay,
     2989     e                   rlat,zmea,zstd,zpic,zgam,zthe,zpic,zval,
     2990     e                   igwd,idx,itest,
     2991     e                   t_seri, u_seri, v_seri,
     2992     s                   zulow, zvlow, zustrli, zvstrli,
     2993     s                   d_t_lif, d_u_lif, d_v_lif               )
     2994       
     2995        ELSE
     2996          CALL lift_noro(klon,klev,dtime,paprs,pplay,
    29722997     e                   rlat,zmea,zstd,zpic,
    29732998     e                   itest,
    … …  
    29753000     s                   zulow, zvlow, zustrli, zvstrli,
    29763001     s                   d_t_lif, d_u_lif, d_v_lif)
    2977 c
     3002       ENDIF
     3003c   
    29783004!-----------------------------------------------------------------------------------------
    29793005! ajout des tendances de la portance de l'orographie
    … …  
    29823008c
    29833009      ENDIF ! fin de test sur ok_orolf
     3010C  HINES GWD PARAMETRIZATION
     3011
     3012       IF (ok_hines) then
     3013
     3014         CALL hines_gwd(klon,klev,dtime,paprs,pplay,
     3015     i                  rlat,t_seri,u_seri,v_seri,
     3016     o                  zustrhi,zvstrhi,
     3017     o                  d_t_hin, d_u_hin, d_v_hin)
     3018c
     3019c  ajout des tendances
     3020        CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'lif')
     3021
     3022      ENDIF
     3023c
     3024
    29843025c
    29853026cIM cf. FLott BEG
    … …  
    33683409         itau_phy = itau_phy + itap
    33693410         CALL phyredem ("restartphy.nc")
    3370          open(97,form="unformatted",file="finbin")
    3371          write(97) u_seri,v_seri,t_seri,q_seri
    3372          close(97)
     3411!         open(97,form="unformatted",file="finbin")
     3412!         write(97) u_seri,v_seri,t_seri,q_seri
     3413!         close(97)
    33733414      ENDIF
    33743415     

  • LMDZ4/trunk/libf/phylmd/surf_land_orchidee_mod.F90

    r996 r1001  
    480480  USE  mod_surf_para
    481481     
    482 #ifdef CPP_PARA
     482#ifdef CPP_MPI
    483483    INCLUDE 'mpif.h'
    484484#endif   
    … …  
    502502      ENDIF
    503503   
    504 #ifdef CPP_PARA   
     504#ifdef CPP_MPI   
    505505      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
    506506#endif
    … …  
    529529    INCLUDE "indicesol.h"
    530530
    531 #ifdef CPP_PARA
     531#ifdef CPP_MPI
    532532    INCLUDE 'mpif.h'
    533533#endif   
Note: See TracChangeset for help on using the changeset viewer.