Changeset 3435 for LMDZ6/trunk/libf


Ignore:
Timestamp:
Jan 22, 2019, 4:21:59 PM (6 years ago)
Author:
Laurent Fairhead
Message:

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

  • as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

  • due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

Location:
LMDZ6/trunk/libf
Files:
7 added
64 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/gcm.F90

    r2622 r3435  
    241241       'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    242242  if (.not.read_start) then
     243     annee_ref=anneeref
    243244     CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    244245  endif
    … …  
    377378       tetagdiv, tetagrot , tetatemp, vert_prof_dissip)
    378379
     380  !  numero de stockage pour les fichiers de redemarrage:
     381
     382  !-----------------------------------------------------------------------
     383  !   Initialisation des I/O :
     384  !   ------------------------
     385
     386
     387  if (nday>=0) then
     388     day_end = day_ini + nday
     389  else
     390     day_end = day_ini - nday/day_step
     391  endif
     392  WRITE(lunout,300)day_ini,day_end
     393300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
     394
     395#ifdef CPP_IOIPSL
     396  call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
     397  write (lunout,301)jour, mois, an
     398  call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
     399  write (lunout,302)jour, mois, an
     400301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
     401302 FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
     402#endif
     403
    379404  !-----------------------------------------------------------------------
    380405  !   Initialisation de la physique :
    … …  
    391416#endif
    392417  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
    393 
    394   !  numero de stockage pour les fichiers de redemarrage:
    395 
    396   !-----------------------------------------------------------------------
    397   !   Initialisation des I/O :
    398   !   ------------------------
    399 
    400 
    401   if (nday>=0) then
    402      day_end = day_ini + nday
    403   else
    404      day_end = day_ini - nday/day_step
    405   endif
    406   WRITE(lunout,300)day_ini,day_end
    407 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
    408 
    409 #ifdef CPP_IOIPSL
    410   call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
    411   write (lunout,301)jour, mois, an
    412   call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
    413   write (lunout,302)jour, mois, an
    414 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
    415 302 FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
    416 #endif
    417418
    418419  !      if (planet_type.eq."earth") then

  • LMDZ6/trunk/libf/dyn3dmem/caladvtrac_mod.F90

    r1907 r3435  
    4444    CALL allocate_u(massem,llm,d)
    4545    CALL allocate_u(pbaruc,llm,d)
     46    pbaruc(:,:)=0
    4647    CALL allocate_v(pbarvc,llm,d)
     48    pbarvc(:,:)=0
    4749    CALL allocate_u(pbarug,llm,d)
    4850    CALL allocate_v(pbarvg,llm,d)

  • LMDZ6/trunk/libf/dyn3dmem/call_calfis_mod.F90

    r2603 r3435  
    5252    CALL allocate_u(p,llmp1,d)
    5353    CALL allocate_u(pks,d)
     54    pks(:)=0
    5455    CALL allocate_u(pk,llm,d)
     56    pk(:,:)=0
    5557    CALL allocate_u(pkf,llm,d)
    5658    CALL allocate_u(phi,llm,d)

  • LMDZ6/trunk/libf/dyn3dmem/call_dissip_mod.F90

    r1987 r3435  
    3131
    3232    CALL allocate_u(ucov,llm,d)
     33    ucov(:,:)=0
    3334    CALL allocate_v(vcov,llm,d)
     35    vcov(:,:)=0
    3436    CALL allocate_u(teta,llm,d)
    3537    CALL allocate_u(p,llmp1,d)

  • LMDZ6/trunk/libf/dyn3dmem/gcm.F90

    r2622 r3435  
    233233       'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    234234  if (.not.read_start) then
     235     annee_ref=anneeref
    235236     CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
    236237  endif
    … …  
    368369
    369370  !-----------------------------------------------------------------------
     371  !   Initialisation des I/O :
     372  !   ------------------------
     373
     374
     375  if (nday>=0) then
     376     day_end = day_ini + nday
     377  else
     378     day_end = day_ini - nday/day_step
     379  endif
     380
     381  WRITE(lunout,300)day_ini,day_end
     382300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
     383
     384#ifdef CPP_IOIPSL
     385  call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
     386  write (lunout,301)jour, mois, an
     387  call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
     388  write (lunout,302)jour, mois, an
     389301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
     390302 FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
     391#endif
     392
     393  !-----------------------------------------------------------------------
    370394  !   Initialisation de la physique :
    371395  !   -------------------------------
    … …  
    381405  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
    382406
    383 
    384   !-----------------------------------------------------------------------
    385   !   Initialisation des I/O :
    386   !   ------------------------
    387 
    388 
    389   if (nday>=0) then
    390      day_end = day_ini + nday
    391   else
    392      day_end = day_ini - nday/day_step
    393   endif
    394 
    395   WRITE(lunout,300)day_ini,day_end
    396 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
    397 
    398 #ifdef CPP_IOIPSL
    399   call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
    400   write (lunout,301)jour, mois, an
    401   call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
    402   write (lunout,302)jour, mois, an
    403 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
    404 302 FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
    405 #endif
    406407
    407408  !      if (planet_type.eq."earth") then

  • LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90

    r2622 r3435  
    101101  time_0=0.
    102102  day_ref=1
    103   annee_ref=0
     103  ! annee_ref=0
    104104
    105105  im         = iim

  • LMDZ6/trunk/libf/dyn3dmem/integrd_mod.F90

    r1907 r3435  
    2323    CALL allocate_u(deltap,llm,d)
    2424    CALL allocate_u(ps,d)
     25    ps(:)=0
    2526
    2627   

  • LMDZ6/trunk/libf/dyn3dmem/vlsplt_loc.F

    r2765 r3435  
    1919      include "dimensions.h"
    2020      include "paramet.h"
     21      include "iniprint.h"
    2122c
    2223c
    … …  
    872873      include "dimensions.h"
    873874      include "paramet.h"
     875      include "iniprint.h"
    874876c
    875877c
    … …  
    10271029      ELSE ! countcfl>=1
    10281030
    1029       PRINT*,'vlz passage dans le non local'
     1031      IF (prt_level>9) THEN
     1032        WRITE(lunout,*)'vlz passage dans le non local'
     1033      ENDIF
    10301034c ---------------------------------------------------------------
    10311035c  Debut du traitement du cas ou on viole le CFL : w > masse
    … …  
    10591063c  le critère
    10601064      DO WHILE (countcfl>=1)
    1061       print*,'On viole le CFL Vertical sur ',countcfl,' pts'
     1065        IF (prt_level>9) THEN
     1066          WRITE(lunout,*)'On viole le CFL Vertical sur ',countcfl,' pts'
     1067        ENDIF
    10621068      countcfl=0
    10631069

  • LMDZ6/trunk/libf/dynphy_lonlat/inigeomphy_mod.F90

    r2963 r3435  
    7676  REAL,ALLOCATABLE,SAVE :: boundslonfi(:,:)
    7777  REAL,ALLOCATABLE,SAVE :: boundslatfi(:,:)
    78 !$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi)
     78  INTEGER,ALLOCATABLE,SAVE :: ind_cell_glo_fi(:)
     79!$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi,ind_cell_glo_fi)
    7980
    8081  ! Initialize Physics distibution and parameters and interface with dynamics
    … …  
    9394 
    9495  DO i=1,iim
     96   boundslon_reg(i,east)=rlonu(i+1)
    9597   boundslon_reg(i,west)=rlonu(i)
    96    boundslon_reg(i,east)=rlonu(i+1)
    9798  ENDDO
    9899
    … …  
    204205  ALLOCATE(boundslonfi(klon_omp,4))
    205206  ALLOCATE(boundslatfi(klon_omp,4))
     207  ALLOCATE(ind_cell_glo_fi(klon_omp))
    206208
    207209
    … …  
    214216  boundslonfi(1:klon_omp,:) = boundslonfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:)
    215217  boundslatfi(1:klon_omp,:) = boundslatfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:)
     218  ind_cell_glo_fi(1:klon_omp)=(/ (i,i=offset+klon_omp_begin,offset+klon_omp_end) /)
    216219
    217220  ! copy over local grid longitudes and latitudes
    218221  CALL init_geometry(klon_omp,lonfi,latfi,boundslonfi,boundslatfi, &
    219                      airefi,cufi,cvfi)
     222                     airefi,ind_cell_glo_fi,cufi,cvfi)
    220223
    221224  ! copy over preff , ap(), bp(), etc

  • LMDZ6/trunk/libf/dynphy_lonlat/phydev/iniphysiq_mod.F90

    r2588 r3435  
    7171  CALL inifis(prad,pg,pr,pcpp)
    7272 
    73   ! Initialize dimphy module
    74   CALL Init_dimphy(klon_omp,nlayer)
    75 
    7673  ! Initialize tracer names, numbers, etc. for physics
    7774  CALL init_infotrac_phy(nqtot,type_trac)

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90

    r2941 r3435  
    100100
    101101  deg2rad = pi/180.0
    102 
     102  y(:,:,:)=0  !ym warning unitialized variable
     103 
    103104! Compute psol AND tsol, knowing phis.
    104105!*******************************************************************************

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

    r3412 r3435  
    4444    zmax0,fevap, rnebcon,falb_dir, wake_fip,    agesno,  detr_therm, pbl_tke,  &
    4545    phys_state_var_init, ql_ancien, qs_ancien, prlw_ancien, prsw_ancien, &
    46     prw_ancien
     46    prw_ancien, sollwdown
    4747  USE comconst_mod, ONLY: pi, dtvr
    4848
    … …  
    201201  solsw      = 165.
    202202  sollw      = -53.
     203!ym warning missing init for sollwdown => set to 0
     204  sollwdown  = 0.
    203205  t_ancien   = 273.15
    204206  q_ancien   = 0.
    … …  
    315317  ALLOCATE(zmea0(iml,jml),zstd0(iml,jml)) !--- Mean orography and std deviation
    316318  ALLOCATE(zsig0(iml,jml),zgam0(iml,jml)) !--- Slope and nisotropy
     319  zsig0(:,:)=0   !ym uninitialized variable
     320  zgam0(:,:)=0   !ym uninitialized variable
    317321  ALLOCATE(zthe0(iml,jml))                !--- Highest slope orientation
     322  zthe0(:,:)=0   !ym uninitialized variable
    318323  ALLOCATE(zpic0(iml,jml),zval0(iml,jml)) !--- Peaks and valley heights
    319324

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r3125 r3435  
    3535  USE phystokenc_mod, ONLY: init_phystokenc
    3636  USE phyaqua_mod, ONLY: iniaqua
     37  USE comconst_mod, ONLY: omeg, rad
    3738#ifdef INCA
    3839  USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic
    … …  
    118119
    119120  ! Initialize dimphy module (unless in 1D where it has already been done)
    120   IF (klon_glo>1) CALL Init_dimphy(klon_omp,nlayer)
     121!  IF (klon_glo>1) CALL Init_dimphy(klon_omp,nlayer)
    121122
    122123  ! Copy over "offline" settings
    … …  
    134135                                  cu,cuvsurcv,cv,cvusurcu, &
    135136                                  aire,apoln,apols, &
    136                                   aireu,airev,rlatvdyn)
     137                                  aireu,airev,rlatvdyn,rad,omeg)
    137138  END IF
    138139

  • LMDZ6/trunk/libf/misc/handle_err_m.F90

    r2094 r3435  
    3939          end if
    4040       end if
    41        call abort_gcm("NetCDF95 handle_err", "", 1)
     41       call abort_physic("NetCDF95 handle_err", "", 1)
    4242    end if
    4343

  • LMDZ6/trunk/libf/misc/wxios.F90

    r3165 r3435  
    1515   
    1616    INTEGER, SAVE :: g_comm
    17     CHARACTER(len=100), SAVE :: g_ctx_name
     17    CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ"
    1818    TYPE(xios_context), SAVE :: g_ctx
    1919!$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx)
    … …  
    136136        g_ctx_name = xios_ctx_name
    137137       
    138         ! Si couple alors init fait dans cpl_init
    139         IF (.not. PRESENT(type_ocean)) THEN
    140             CALL wxios_context_init()
    141         ENDIF
     138!        ! Si couple alors init fait dans cpl_init
     139!        IF (.not. PRESENT(type_ocean)) THEN
     140!            CALL wxios_context_init()
     141!        ENDIF
    142142
    143143    END SUBROUTINE wxios_init
    … …  
    145145    SUBROUTINE wxios_context_init()
    146146        USE print_control_mod, ONLY : prt_level, lunout
    147 !        USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
     147        USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
    148148        IMPLICIT NONE
    149149
    … …  
    152152!$OMP MASTER
    153153        !Initialisation du contexte:
    154         CALL xios_context_initialize(g_ctx_name, g_comm)
     154        !!CALL xios_context_initialize(g_ctx_name, g_comm)
     155        CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
    155156        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
    156157        CALL xios_set_current_context(xios_ctx)            !Activation
    … …  
    165166!$OMP END MASTER
    166167    END SUBROUTINE wxios_context_init
     168
     169
     170    SUBROUTINE wxios_set_context()
     171        IMPLICIT NONE
     172        TYPE(xios_context) :: xios_ctx
     173
     174       !$OMP MASTER
     175        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
     176        CALL xios_set_current_context(xios_ctx)            !Activation
     177       !$OMP END MASTER
     178
     179    END SUBROUTINE wxios_set_context
    167180
    168181    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    203216            CASE DEFAULT
    204217                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
    205                 CALL abort_gcm('Gcm:Xios',abort_message,1)
     218                CALL abort_physic('Gcm:Xios',abort_message,1)
    206219        END SELECT
    207220       
    … …  
    237250    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
    238251    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    239     SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo,        &
    240                                     ibegin, iend, ii_begin, ii_end, jbegin, jend,       &
    241                                     data_ni, data_ibegin, data_iend,                    &
    242                                     io_lat, io_lon,is_south_pole,mpi_rank)
    243          
    244 
    245         USE print_control_mod, ONLY : prt_level, lunout
    246         IMPLICIT NONE
    247 
     252    SUBROUTINE wxios_domain_param(dom_id)
     253       USE dimphy, only: klon
     254       USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast
     255       USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
     256                                     mpi_size, mpi_rank, klon_mpi, &
     257                                     is_sequential, is_south_pole_dyn
     258       USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo         
     259       USE print_control_mod, ONLY : prt_level, lunout
     260       USE geometry_mod
     261
     262       IMPLICIT NONE
    248263        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
    249         LOGICAL,INTENT(IN) :: is_sequential ! flag
    250         INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
    251         INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
    252         INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
    253         INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
    254         INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain
    255         INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
    256         INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
    257         INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
    258         INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain
    259         INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
    260         INTEGER,INTENT(IN) :: data_ni
    261         INTEGER,INTENT(IN) :: data_ibegin
    262         INTEGER,INTENT(IN) :: data_iend
    263         REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
    264         REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
    265         logical,intent(in) :: is_south_pole ! does this process include the south pole?
    266         integer,intent(in) :: mpi_rank ! rank of process
    267        
     264
     265        REAL   :: rlat_glo(klon_glo)
     266        REAL   :: rlon_glo(klon_glo)
     267        REAL   :: io_lat(nbp_lat)
     268        REAL   :: io_lon(nbp_lon)
     269        LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
    268270        TYPE(xios_domain) :: dom
     271        INTEGER :: i
    269272        LOGICAL :: boool
    270273       
    271         !Masque pour les problèmes de recouvrement MPI:
    272         LOGICAL :: mask(ni,nj)
     274
     275
     276        CALL gather(latitude_deg,rlat_glo)
     277        CALL bcast(rlat_glo)
     278        CALL gather(longitude_deg,rlon_glo)
     279        CALL bcast(rlon_glo)
     280   
     281  !$OMP MASTER 
     282        io_lat(1)=rlat_glo(1)
     283        io_lat(nbp_lat)=rlat_glo(klon_glo)
     284        IF ((nbp_lon*nbp_lat) > 1) then
     285          DO i=2,nbp_lat-1
     286            io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
     287          ENDDO
     288        ENDIF
     289
     290        IF (klon_glo == 1) THEN
     291          io_lon(1)=rlon_glo(1)
     292        ELSE
     293          io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
     294        ENDIF
     295
    273296       
    274297        !On récupère le handle:
    275298        CALL xios_get_domain_handle(dom_id, dom)
    276299       
    277         IF (prt_level >= 10) THEN
    278           WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
    279           WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
    280           WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
    281           WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
    282         ENDIF
    283        
    284300        !On parametrise le domaine:
    285         CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin-1, ni=ni, type="rectilinear")
    286         CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin-1, nj=nj, data_dim=2)
    287         CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(ibegin:iend), latvalue_1d=io_lat(jbegin:jend))
     301        CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
     302        CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
     303        CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
     304        CALL xios_set_domain_attr("dom_out", domain_ref=dom_id)
     305
    288306        !On definit un axe de latitudes pour les moyennes zonales
    289307        IF (xios_is_valid_axis("axis_lat")) THEN
    290            CALL xios_set_axis_attr( "axis_lat", n_glo=nj_glo, n=nj, begin=jbegin-1, value=io_lat(jbegin:jend))
     308           CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end))
    291309        ENDIF
    292310
    … …  
    294312            mask(:,:)=.TRUE.
    295313            if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
    296             if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
     314            if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
    297315            ! special case for south pole
    298             if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
     316            if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true.
    299317            IF (prt_level >= 10) THEN
    300318              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
    301               WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
     319              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
    302320            ENDIF
    303321            CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
    … …  
    311329            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
    312330        END IF
     331!$OMP END MASTER
     332       
    313333    END SUBROUTINE wxios_domain_param
    314334   
     335
     336    SUBROUTINE wxios_domain_param_unstructured(dom_id)
     337        USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
     338        USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo
     339        USE mod_phys_lmdz_para
     340        USE nrtype, ONLY : PI
     341        USE ioipsl_getin_p_mod, ONLY : getin_p
     342        IMPLICIT NONE
     343        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
     344        REAL :: lon_mpi(klon_mpi)
     345        REAL :: lat_mpi(klon_mpi)
     346        REAL :: boundslon_mpi(klon_mpi,nvertex)
     347        REAL :: boundslat_mpi(klon_mpi,nvertex)
     348        INTEGER :: ind_cell_glo_mpi(klon_mpi)
     349        TYPE(xios_domain) :: dom
     350        LOGICAL :: remap_output
     351
     352        CALL gather_omp(longitude*180/PI,lon_mpi)
     353        CALL gather_omp(latitude*180/PI,lat_mpi)
     354        CALL gather_omp(boundslon*180/PI,boundslon_mpi)
     355        CALL gather_omp(boundslat*180/PI,boundslat_mpi)
     356        CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
     357       
     358        remap_output=.TRUE.
     359        CALL getin_p("remap_output",remap_output)
     360
     361!$OMP MASTER
     362        CALL xios_get_domain_handle(dom_id, dom)
     363       
     364        !On parametrise le domaine:
     365        CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
     366        CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
     367                           bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
     368        CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
     369        IF (remap_output) THEN
     370          CALL xios_set_domain_attr("dom_out", domain_ref="dom_regular")
     371          CALL xios_set_fieldgroup_attr("dom_out", domain_ref="dom_regular")
     372          CALL xios_set_fieldgroup_attr("remap_expr", expr="@this_ref")
     373        ENDIF
     374!$OMP END MASTER
     375
     376    END SUBROUTINE wxios_domain_param_unstructured
     377
     378
     379
     380
    315381    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    316382    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!

  • LMDZ6/trunk/libf/phy_common/geometry_mod.F90

    r2395 r3435  
    3030!$OMP THREADPRIVATE(cell_area)
    3131
     32  INTEGER,SAVE,ALLOCATABLE :: ind_cell_glo(:)      ! global indice of a local cell
     33!$OMP THREADPRIVATE(ind_cell_glo)
    3234
    3335CONTAINS
    … …  
    3537  SUBROUTINE init_geometry(klon,longitude_,latitude_, &
    3638                           boundslon_,boundslat_, &
    37                            cell_area_,dx_,dy_)
     39                           cell_area_,ind_cell_glo_,dx_,dy_)
    3840  USE mod_grid_phy_lmdz, ONLY: nvertex
    3941  USE nrtype, ONLY : PI
    … …  
    4547    REAL,INTENT(IN) :: boundslat_(klon,nvertex)
    4648    REAL,INTENT(IN) :: cell_area_(klon)
     49    INTEGER,OPTIONAL,INTENT(IN) :: ind_cell_glo_(klon)
    4750    REAL,OPTIONAL,INTENT(IN) :: dx_(klon)
    4851    REAL,OPTIONAL,INTENT(IN) :: dy_(klon)
    … …  
    5558    ALLOCATE(boundslat(klon,nvertex))
    5659    ALLOCATE(cell_area(klon))
     60    IF (PRESENT(ind_cell_glo_)) ALLOCATE(ind_cell_glo(klon))
    5761    IF (PRESENT(dx_)) ALLOCATE(dx(klon))
    5862    IF (PRESENT(dy_))ALLOCATE(dy(klon))
    … …  
    6569    boundslat(:,:) = boundslat_(:,:)
    6670    cell_area(:) = cell_area_(:)
     71    IF (PRESENT(ind_cell_glo_)) ind_cell_glo(:) = ind_cell_glo_(:)
    6772    IF (PRESENT(dx_)) dx(:) = dx_(:)
    6873    IF (PRESENT(dy_)) dy(:) = dy_(:)

  • LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.F90

    r2429 r3435  
    33!
    44MODULE mod_phys_lmdz_mpi_data
    5 !  USE mod_const_mpi
    65 
    76  INTEGER,SAVE :: ii_begin
    … …  
    3635  INTEGER,SAVE :: mpi_size
    3736  INTEGER,SAVE :: mpi_master
    38 !  INTEGER,SAVE :: mpi_root
    3937  LOGICAL,SAVE :: is_mpi_root
    4038  LOGICAL,SAVE :: is_using_mpi
    4139 
    4240 
    43 !  LOGICAL,SAVE :: is_north_pole
    44 !  LOGICAL,SAVE :: is_south_pole
    4541  LOGICAL,SAVE :: is_north_pole_dyn
    4642  LOGICAL,SAVE :: is_south_pole_dyn
    … …  
    5046CONTAINS
    5147 
    52 !  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
    5348  SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, communicator)
    54 !  USE mod_const_mpi, ONLY : COMM_LMDZ
    5549  IMPLICIT NONE
    5650#ifdef CPP_MPI
    5751    INCLUDE 'mpif.h'
    5852#endif
    59     INTEGER,INTENT(in) :: nbp
    60     INTEGER,INTENT(in) :: nbp_lon
    61     INTEGER,INTENT(in) :: nbp_lat
    62     INTEGER,INTENT(in) :: communicator
     53    INTEGER,INTENT(IN) :: nbp
     54    INTEGER,INTENT(IN) :: nbp_lon
     55    INTEGER,INTENT(IN) :: nbp_lat
     56    INTEGER,INTENT(IN) :: communicator
    6357   
    6458    INTEGER,ALLOCATABLE :: distrib(:)
    … …  
    189183
    190184  SUBROUTINE print_module_data
    191 !  USE print_control_mod, ONLY: lunout
     185  USE print_control_mod, ONLY: lunout
    192186  IMPLICIT NONE
    193   INCLUDE "iniprint.h"
     187!  INCLUDE "iniprint.h"
    194188 
    195189    WRITE(lunout,*) 'ii_begin =', ii_begin

  • LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_data.F90

    r2429 r3435  
    77  INTEGER,SAVE :: omp_rank
    88  LOGICAL,SAVE :: is_omp_root
     9  LOGICAL,SAVE :: is_omp_master  ! alias of is_omp_root
    910  LOGICAL,SAVE :: is_using_omp
    1011  LOGICAL,SAVE :: is_north_pole_phy, is_south_pole_phy
    … …  
    1718  INTEGER,SAVE :: klon_omp_begin
    1819  INTEGER,SAVE :: klon_omp_end
    19 !$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
     20!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,is_omp_master,klon_omp_begin,klon_omp_end)
    2021!$OMP  THREADPRIVATE(is_north_pole_phy, is_south_pole_phy)
    2122
    … …  
    6061   ELSE
    6162     abort_message = 'ANORMAL : OMP_MASTER /= 0'
    62      CALL abort_gcm (modname,abort_message,1)
     63     CALL abort_physic (modname,abort_message,1)
    6364   ENDIF
    6465!$OMP END MASTER
    65 
     66   is_omp_master=is_omp_root
    6667
    6768!$OMP MASTER
    … …  
    106107
    107108  SUBROUTINE Print_module_data
     109  USE print_control_mod, ONLY: lunout
    108110  IMPLICIT NONE
    109   INCLUDE "iniprint.h"
     111!  INCLUDE "iniprint.h"
    110112
    111113!$OMP CRITICAL 

  • LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.F90

    r2429 r3435  
    4949  SUBROUTINE Test_transfert
    5050  USE mod_grid_phy_lmdz
     51  USE print_control_mod, ONLY: lunout
    5152  IMPLICIT NONE
    52     INCLUDE "iniprint.h"
     53!    INCLUDE "iniprint.h"
    5354 
    5455    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)

  • LMDZ6/trunk/libf/phy_common/physics_distribution_mod.F90

    r2351 r3435  
    1010                                       nbp, nbp_lon, nbp_lat, nbp_lev, &
    1111                                       communicator)
    12   USE mod_phys_lmdz_para, ONLY: init_phys_lmdz_para
     12  USE mod_phys_lmdz_para, ONLY: init_phys_lmdz_para, klon_omp
    1313  USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz
     14  USE dimphy, ONLY : Init_dimphy
     15  USE infotrac_phy, ONLY : type_trac
     16#ifdef REPROBUS
     17  USE CHEM_REP, ONLY : Init_chem_rep_phys
     18#endif
     19
    1420  IMPLICIT NONE
    1521    INTEGER,INTENT(IN) :: grid_type
    … …  
    2430    CALL init_grid_phy_lmdz(grid_type,nvertex, nbp_lon,nbp_lat,nbp_lev)
    2531    CALL init_phys_lmdz_para(nbp,nbp_lon, nbp_lat, communicator)
     32!$OMP PARALLEL
     33    CALL init_dimphy(klon_omp,nbp_lev)
     34
     35! Initialization of Reprobus
     36    IF (type_trac == 'repr') THEN
     37#ifdef REPROBUS
     38       CALL Init_chem_rep_phys(klon_omp,nbp_lev)
     39#endif
     40    END IF
     41
     42!$OMP END PARALLEL
    2643
    2744  END SUBROUTINE init_physics_distribution 

  • LMDZ6/trunk/libf/phy_common/print_control_mod.F90

    r2326 r3435  
    77!$OMP THREADPRIVATE(lunout,prt_level,debug)
    88
     9  ! NB: Module variable Initializations done by set_print_control
     10  !     routine from init_print_control_mod to avoid circular
     11  !     module dependencies
     12
    913CONTAINS
    1014
    11   SUBROUTINE init_print_control
    12   USE ioipsl_getin_p_mod, ONLY : getin_p
    13   USE mod_phys_lmdz_para, ONLY: is_omp_root, is_master
     15  SUBROUTINE set_print_control(lunout_,prt_level_,debug_)
    1416  IMPLICIT NONE
    15 
    16     LOGICAL :: opened
    17     INTEGER :: number
     17    INTEGER :: lunout_
     18    INTEGER :: prt_level_
     19    LOGICAL :: debug_
     20     
     21    lunout = lunout_
     22    prt_level = prt_level_
     23    debug = debug_
    1824   
    19     !Config  Key  = prt_level
    20     !Config  Desc = niveau d'impressions de débogage
    21     !Config  Def  = 0
    22     !Config  Help = Niveau d'impression pour le débogage
    23     !Config         (0 = minimum d'impression)
    24     prt_level = 0
    25     CALL getin_p('prt_level',prt_level)
    26 
    27     !Config  Key  = lunout
    28     !Config  Desc = unite de fichier pour les impressions
    29     !Config  Def  = 6
    30     !Config  Help = unite de fichier pour les impressions
    31     !Config         (defaut sortie standard = 6)
    32     lunout=6
    33     CALL getin_p('lunout', lunout)
    34 
    35     IF (is_omp_root) THEN
    36       IF (lunout /= 5 .and. lunout /= 6) THEN
    37          INQUIRE(FILE='lmdz.out_0000',OPENED=opened,NUMBER=number)
    38          IF (opened) THEN
    39            lunout=number
    40          ELSE
    41            OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write',  &
    42                 STATUS='unknown',FORM='formatted')
    43          ENDIF
    44       ENDIF
    45     ENDIF
    46 
    47     !Config  Key  = debug
    48     !Config  Desc = mode debogage
    49     !Config  Def  = false
    50     !Config  Help = positionne le mode debogage
    51 
    52     debug = .FALSE.
    53     CALL getin_p('debug',debug)
    54    
    55     IF (is_master) THEN
    56       WRITE(lunout,*)"init_print_control: prt_level=",prt_level
    57       WRITE(lunout,*)"init_print_control: lunout=",lunout
    58       WRITE(lunout,*)"init_print_control: debug=",debug     
    59     ENDIF
    60    
    61   END SUBROUTINE init_print_control 
     25  END SUBROUTINE set_print_control
    6226
    6327END MODULE print_control_mod

  • LMDZ6/trunk/libf/phydev/inifis_mod.F90

    r2311 r3435  
    1 ! $Id: $
     1! $Id$
    22MODULE inifis_mod
    33
    … …  
    66  SUBROUTINE inifis(prad, pg, pr, pcpp)
    77  ! Initialize some physical constants and settings
    8   USE print_control_mod, ONLY: init_print_control
     8  USE init_print_control_mod, ONLY: init_print_control
    99  USE comcstphy, ONLY: rradius, & ! planet radius (m)
    1010                       rr, & ! recuced gas constant: R/molar mass of atm

  • LMDZ6/trunk/libf/phylmd/add_phys_tend_mod.F90

    r2848 r3435  
     1!
     2! $Id$
     3!
    14!
    25MODULE add_phys_tend_mod
    … …  
    98101
    99102USE dimphy, ONLY: klon, klev
    100 USE phys_state_var_mod, ONLY : dtime
     103USE phys_state_var_mod, ONLY : phys_tstep
    101104USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q_seri, t_seri
    102105USE phys_state_var_mod, ONLY: ftsol
    … …  
    451454    ! ------------------------------------------------
    452455
    453     d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/dtime
    454     d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/dtime
    455     d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/dtime
     456    d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/phys_tstep
     457    d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep
     458    d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep
    456459    d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:)
    457460
    458     d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/dtime
    459 
    460     d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/dtime
    461     d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/dtime
    462     d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/dtime
    463     d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/dtime
    464 
    465     d_h_col = (zh_col(:,2)-zh_col(:,1))/dtime
     461    d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep
     462
     463    d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/phys_tstep
     464    d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/phys_tstep
     465    d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep
     466    d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep
     467
     468    d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep
    466469
    467470  end if ! end if (fl_ebil .GT. 0)
    … …  
    494497!======================================================================
    495498
    496 USE phys_state_var_mod, ONLY : dtime, ftsol
     499USE phys_state_var_mod, ONLY : phys_tstep, ftsol
    497500USE geometry_mod, ONLY: longitude_deg, latitude_deg
    498501USE print_control_mod, ONLY: prt_level
    … …  
    621624    ! ------------------------------------------------
    622625
    623     d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/dtime
    624     d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/dtime
    625     d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/dtime
     626    d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/phys_tstep
     627    d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep
     628    d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep
    626629    d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:)
    627630
    628     d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/dtime
     631    d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep
    629632
    630633   print *,'zdu ', zdu
    … …  
    632635   print *,'d_ek_col, zek_col(2), zek_col(1) ',d_ek_col(1), zek_col(1,2), zek_col(1,1)
    633636
    634     d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/dtime
    635     d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/dtime
    636     d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/dtime
    637     d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/dtime
    638 
    639     d_h_col = (zh_col(:,2)-zh_col(:,1))/dtime
     637    d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/phys_tstep
     638    d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/phys_tstep
     639    d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep
     640    d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep
     641
     642    d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep
    640643
    641644  end if ! end if (fl_ebil .GT. 0)
    … …  
    716719
    717720USE dimphy, ONLY: klon, klev
    718 USE phys_state_var_mod, ONLY : dtime
     721USE phys_state_var_mod, ONLY : phys_tstep
    719722USE phys_state_var_mod, ONLY : topsw, toplw, solsw, sollw, rain_con, snow_con
    720723USE geometry_mod, ONLY: longitude_deg, latitude_deg

  • LMDZ6/trunk/libf/phylmd/calcul_divers.h

    r2825 r3435  
    11!
    2 ! $Header$
     2! $Id$
     3!
    34!
    45! Initialisations diverses au tout debut
    … …  
    1415
    1516! Calcul fin de journee : total_rain, nday_rain
    16       IF(MOD(itap,NINT(un_jour/dtime)).EQ.0) THEN
     17      IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
    1718!        print*,'calcul nday_rain itap ',itap
    1819         DO i = 1, klon
    … …  
    2324
    2425! Initialisation fin de mois
    25       IF(MOD(itap-itapm1,NINT(mth_len*un_jour/dtime)).EQ.0) THEN
    26         itapm1=itapm1+NINT(mth_len*un_jour/dtime)
     26      IF(MOD(itap-itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.0) THEN
     27        itapm1=itapm1+NINT(mth_len*un_jour/phys_tstep)
    2728!       print*,'initialisation itapm1 ',itapm1
    2829      ENDIF
    … …  
    3536     t2m_max_mon=0.
    3637  ENDIF
    37   IF(MOD(itap,NINT(un_jour/dtime)).EQ.1) THEN
     38  IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN
    3839     zt2m_min_mon=zt2m
    3940     zt2m_max_mon=zt2m
    … …  
    4546     ENDDO
    4647!fin de journee
    47   IF(MOD(itap,NINT(un_jour/dtime)).EQ.0) THEN
     48  IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN
    4849   t2m_min_mon=t2m_min_mon+zt2m_min_mon
    4950   t2m_max_mon=t2m_max_mon+zt2m_max_mon

  • LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.F90

    r3421 r3435  
    582582  SUBROUTINE infocfields_init
    583583
    584     USE control_mod, ONLY: planet_type
     584!    USE control_mod, ONLY: planet_type
    585585    USE phys_cal_mod, ONLY : mth_cur
    586586    USE mod_synchro_omp
    … …  
    656656
    657657  CHARACTER(len=*),parameter :: modname="infocfields"
     658
     659  CHARACTER(len=10),SAVE :: planet_type="earth"
    658660
    659661!-----------------------------------------------------------------------
    … …  
    718720                  WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
    719721                  WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
    720                   CALL abort_gcm('infocfields_init','Problem in the definition of the coupling fields',1)
     722                  CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
    721723               ENDIF
    722724             ENDDO !DO iq=1,nbcf
    … …  
    836838
    837839 ALLOCATE(fields_in(klon,nbcf_in),stat=error)
    838  IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fields_in',1)
     840 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_in',1)
    839841 ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
    840  IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation yfields_in',1)
     842 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_in',1)
    841843 ALLOCATE(fields_out(klon,nbcf_out),stat=error)
    842  IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fields_out',1)
     844 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_out',1)
    843845 ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
    844  IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation yfields_out',1)
     846 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_out',1)
    845847
    846848END SUBROUTINE infocfields_init

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

    r3327 r3435  
    7070!IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
    7171!IM freq_calNMC : frequences de calcul fis. hist*NMC.nc
    72 !IM pasphys : pas de temps de physique (secondes)
    73        REAL pasphys
    7472       LOGICAL ok_histNMC(3)
    7573       INTEGER levout_histNMC(3)
    … …  
    111109     &     , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce   &
    112110     &     , z0m_seaice,z0h_seaice                                      &
    113      &     , pasphys            , freq_outNMC, freq_calNMC              &
     111     &     , freq_outNMC, freq_calNMC                                   &
    114112     &     , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins             &
    115113     &     , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS              &

  • LMDZ6/trunk/libf/phylmd/coef_diff_turb_mod.F90

    r3102 r3435  
    6565
    6666
     67    ykmm = 0 !ym missing init
     68    ykmn = 0 !ym missing init
     69    ykmq = 0 !ym missing init
     70   
     71   
    6772!****************************************************************************************   
    6873! Calcul de coefficients de diffusion turbulent de l'atmosphere :

  • LMDZ6/trunk/libf/phylmd/conf_phys_m.F90

    r3420 r3435  
    2929    USE mod_grid_phy_lmdz, ONLY: klon_glo
    3030    USE print_control_mod, ONLY: lunout
     31    USE phys_state_var_mod, ONLY: phys_tstep
    3132
    3233    INCLUDE "conema3.h"
    … …  
    150151
    151152    REAL,SAVE :: R_ecc_omp,R_peri_omp,R_incl_omp,solaire_omp
    152     REAL      :: solaire_omp_init
     153    REAL,SAVE      :: solaire_omp_init
    153154    LOGICAL,SAVE :: ok_suntime_rrtm_omp
    154155    REAL,SAVE :: co2_ppm_omp, RCO2_omp, co2_ppm_per_omp, RCO2_per_omp
    … …  
    10301031    ! - 1 = stratospheric aerosols scaled from 550 nm AOD
    10311032    ! - 2 = stratospheric aerosol properties from CMIP6
    1032     !Option 2 is only available with RRTM, this is tested later on
     1033    !Option 2 is only available with RRTM, this is tested later on 
    10331034    !Config Def  = 0
    10341035    !Config Help = Used in physiq.F
    … …  
    17231724    !Config Desc = freq_calNMC(2) = frequence de calcul fichiers histdayNMC
    17241725    !Config Desc = freq_calNMC(3) = frequence de calcul fichiers histhfNMC
    1725     !Config Def  = pasphys
    1726     !Config Help =
    1727     !
    1728     freq_calNMC_omp(1) = pasphys
    1729     freq_calNMC_omp(2) = pasphys
    1730     freq_calNMC_omp(3) = pasphys
     1726    !Config Def  = phys_tstep
     1727    !Config Help =
     1728    !
     1729    freq_calNMC_omp(1) = phys_tstep
     1730    freq_calNMC_omp(2) = phys_tstep
     1731    freq_calNMC_omp(3) = phys_tstep
    17311732    CALL getin('freq_calNMC',freq_calNMC_omp)
    17321733    !

  • LMDZ6/trunk/libf/phylmd/cosp/phys_cosp.F90

    r3403 r3435  
    354354      !$OMP END MASTER
    355355      !$OMP BARRIER
    356         debut_cosp=.false.
    357356      endif ! debut_cosp
    358357!    else
    … …  
    366365!        call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
    367366!#else
    368        call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
     367     if (.NOT. debut_cosp) call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
    369368!#endif
    370369!!
    … …  
    374373
    375374!       print *, 'Calling write output'
    376        call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, missing_val, &
     375     if (.NOT. debut_cosp) call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, missing_val, &
    377376                               cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, &
    378377                               isccp, misr, modis)
    … …  
    400399!  call system_clock(t1,count_rate,count_max)
    401400!  print *,(t1-t0)*1.0/count_rate
     401    if (debut_cosp) then
     402      debut_cosp=.false.
     403    endif
    402404 
    403405  CONTAINS

  • LMDZ6/trunk/libf/phylmd/cosp2/cosp_output_mod.F90

    r3369 r3435  
    359359   WRITE(lunout,*) 'wxios_add_vaxis cth16 numMISRHgtBins, misr_histHgtCenters ', &
    360360                    numMISRHgtBins, misr_histHgtCenters
    361    CALL wxios_add_vaxis("cth", numMISRHgtBins, misr_histHgtCenters)
     361   CALL wxios_add_vaxis("cth16", numMISRHgtBins, misr_histHgtCenters)
    362362
    363363   WRITE(lunout,*) 'wxios_add_vaxis dbze DBZE_BINS, dbze_ax ', &

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

    r3102 r3435  
    105105    USE surface_data
    106106    USE indice_sol_mod
    107     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     107    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo
    108108    USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
    109109    USE print_control_mod, ONLY: lunout
    … …  
    236236       idayref = day_ini
    237237       CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
    238        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon,zx_lon)
     238       CALL grid1dTo2d_glo(rlon,zx_lon)
    239239       DO i = 1, nbp_lon
    240240          zx_lon(i,1) = rlon(i+1)
    241241          zx_lon(i,nbp_lat) = rlon(i+1)
    242242       ENDDO
    243        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat,zx_lat)
     243       CALL grid1dTo2d_glo(rlat,zx_lat)
    244244       clintocplnam="cpl_atm_tauflx"
    245245       CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),&

  • LMDZ6/trunk/libf/phylmd/cv3_routines.F90

    r3345 r3435  
    37493749    END DO ! cld
    37503750
     3751!ym BIG Warning : it seems that the k loop is missing !!!
     3752!ym Strong advice to check this
     3753!ym add a k loop temporary
     3754
    37513755! (particular case: no detraining level is found)                              ! cld
     3756! Verif merge Dynamico<<<<<<< .working
    37523757    DO il = 1, ncum                                                            ! cld
    37533758      IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN              ! cld
    … …  
    37613766      END IF                                                                   ! cld
    37623767    END DO                                                                     ! cld
     3768! Verif merge Dynamico =======
     3769! Verif merge Dynamico     DO k = i + 1, nl
     3770! Verif merge Dynamico       DO il = 1, ncum        !ym k loop added                                    ! cld
     3771! Verif merge Dynamico         IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN              ! cld
     3772! Verif merge Dynamico           qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i)                 ! cld
     3773! Verif merge Dynamico           qtment(il, i) = qent(il,k,i) + qtment(il,i)                          ! cld
     3774! Verif merge Dynamico           nqcond(il, i) = nqcond(il, i) + 1.                                     ! cld
     3775! Verif merge Dynamico         END IF                                                                   ! cld
     3776! Verif merge Dynamico       END DO
     3777! Verif merge Dynamico     ENDDO                                                                     ! cld
     3778! Verif merge Dynamico >>>>>>> .merge-right.r3413
    37633779
    37643780    DO il = 1, ncum                                                            ! cld

  • LMDZ6/trunk/libf/phylmd/cva_driver.F90

    r3197 r3435  
    613613  asupmaxmin1(:) = 0.
    614614
     615  tvp(:, :) = 0. !ym missing init, need to have a look by developpers
     616  tv(:, :) = 0. !ym missing init, need to have a look by developpers
     617   
    615618  DO il = 1, len
    616619    cin1(il) = -100000.

  • LMDZ6/trunk/libf/phylmd/dimphy.F90

    r2656 r3435  
    3333!$OMP END MASTER   
    3434    ALLOCATE(zmasq(klon))   
     35    zmasq=0.
    3536   
    3637  END SUBROUTINE Init_dimphy

  • LMDZ6/trunk/libf/phylmd/grid_noro_m.F90

    r2665 r3435  
     1!
     2! $Id$
     3!
    14MODULE grid_noro_m
    25!
    … …  
    334337  imar=assert_eq(SIZE(x),SIZE(zphi,1),SIZE(mask,1),TRIM(modname)//" imar")-1
    335338  jmar=assert_eq(SIZE(y),SIZE(zphi,2),SIZE(mask,2),TRIM(modname)//" jmar")
    336 ! IF(imar/=iim)   CALL abort_gcm(TRIM(modname),'imar/=iim'  ,1)
    337 ! IF(jmar/=jjm+1) CALL abort_gcm(TRIM(modname),'jmar/=jjm+1',1)
    338339  iext=imdp/10
    339340  xpi = ACOS(-1.)

  • LMDZ6/trunk/libf/phylmd/ini_undefSTD.F90

    r2346 r3435  
    5555
    5656    IF (n==1 .AND. itap-itapm1==1 .OR. n>1 .AND. mod(itap,nint( &
    57         freq_outnmc(n)/dtime))==1) THEN
     57        freq_outnmc(n)/phys_tstep))==1) THEN
    5858      ! print*,'ini_undefSTD n itap',n,itap
    5959      DO k = 1, nlevstd

  • LMDZ6/trunk/libf/phylmd/inifis_mod.F90

    r2311 r3435  
    66  SUBROUTINE inifis(punjours, prad, pg, pr, pcpp)
    77  ! Initialize some physical constants and settings
    8   USE print_control_mod, ONLY: init_print_control, lunout
     8  USE init_print_control_mod, ONLY : init_print_control
     9  USE print_control_mod, ONLY: lunout
    910  IMPLICIT NONE
    1011

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

    r3266 r3435  
    1818#ifdef CPP_XIOS
    1919  INTERFACE histwrite_phy
    20 !#ifdef CPP_XIOSnew
    2120    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
    22 !#else
    23 !    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios
    24 !#endif
    25 
    2621  END INTERFACE
    2722#else
    … …  
    5247                                  mpi_size, mpi_rank, klon_mpi, &
    5348                                is_sequential, is_south_pole_dyn
    54     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
    55     USE print_control_mod, ONLY: prt_level,lunout
     49  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
     50  USE print_control_mod, ONLY: prt_level,lunout
    5651#ifdef CPP_IOIPSL
    5752    USE ioipsl, ONLY: flio_dom_set
    5853#endif
    5954#ifdef CPP_XIOS
    60     USE wxios, ONLY: wxios_domain_param
     55  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init
    6156#endif
    6257    IMPLICIT NONE
    … …  
    7772    INTEGER :: data_ibegin, data_iend
    7873
    79     CALL gather(rlat,rlat_glo)
    80     CALL bcast(rlat_glo)
    81     CALL gather(rlon,rlon_glo)
    82     CALL bcast(rlon_glo)
     74#ifdef CPP_XIOS
     75      CALL wxios_context_init
     76#endif
     77   
     78
     79    IF (grid_type==unstructured) THEN
     80   
     81#ifdef CPP_XIOS
     82      CALL wxios_domain_param_unstructured("dom_glo")
     83#endif
     84
     85    ELSE
     86
     87      CALL gather(rlat,rlat_glo)
     88      CALL bcast(rlat_glo)
     89      CALL gather(rlon,rlon_glo)
     90      CALL bcast(rlon_glo)
    8391   
    8492!$OMP MASTER 
    … …  
    133141#endif
    134142#ifdef CPP_XIOS
    135     ! Set values for the mask:
    136     IF (mpi_rank == 0) THEN
    137         data_ibegin = 0
    138     ELSE
    139         data_ibegin = ii_begin - 1
    140     ENDIF
    141 
    142     IF (mpi_rank == mpi_size-1) THEN
    143         data_iend = nbp_lon
    144     ELSE
    145         data_iend = ii_end + 1
    146     ENDIF
    147 
    148     IF (prt_level>=10) THEN
    149       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
    150       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
    151       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    152       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    153       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
    154     ENDIF
    155 
    156     ! Initialize the XIOS domain coreesponding to this process:
    157     CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
    158                             1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
    159                             klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
    160                             io_lat, io_lon,is_south_pole_dyn,mpi_rank)
     143      ! Set values for the mask:
     144      IF (mpi_rank == 0) THEN
     145          data_ibegin = 0
     146      ELSE
     147          data_ibegin = ii_begin - 1
     148      END IF
     149
     150      IF (mpi_rank == mpi_size-1) THEN
     151          data_iend = nbp_lon
     152      ELSE
     153          data_iend = ii_end + 1
     154      END IF
     155
     156      IF (prt_level>=10) THEN
     157        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
     158        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
     159        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     160        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     161        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
     162      ENDIF
     163
     164      ! Initialize the XIOS domain coreesponding to this process:
    161165#endif
    162166!$OMP END MASTER
     167
     168#ifdef CPP_XIOS   
     169        CALL wxios_domain_param("dom_glo")
     170#endif
     171     
     172    ENDIF
    163173     
    164174  END SUBROUTINE init_iophy_new
    … …  
    291301                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    292302                                mpi_rank
    293   USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat
     303  USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo
    294304  USE ioipsl, ONLY: histbeg
    295305
    … …  
    366376     ENDDO
    367377
    368        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon)
     378       CALL grid1dTo2d_glo(rlon_glo,zx_lon)
    369379       IF ((nbp_lon*nbp_lat).GT.1) THEN
    370380       DO i = 1, nbp_lon
    … …  
    373383       ENDDO
    374384       ENDIF
    375        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat)
     385       CALL grid1dTo2d_glo(rlat_glo,zx_lat)
    376386
    377387    DO i=1,pim
    … …  
    963973                                 nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
    964974  USE print_control_mod, ONLY: prt_level,lunout
    965   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     975  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
    966976#ifdef CPP_XIOS
    967977  USE xios, ONLY: xios_send_field
    968978#endif
     979  USE print_control_mod, ONLY: lunout, prt_level
    969980
    970981  IMPLICIT NONE
    … …  
    10071018      IF (.not. ok_all_xml) THEN
    10081019      IF (prt_level >= 10) THEN
    1009       WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name)
     1020      write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
     1021                     trim(var%name)
    10101022      ENDIF
    10111023      DO iff=iff_beg, iff_end
    … …  
    10371049    ENDIF
    10381050!$OMP MASTER
    1039     CALL grid1Dto2D_mpi(buffer_omp,Field2d)
     1051    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    10401052
    10411053! La boucle sur les fichiers:
    … …  
    10471059             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
    10481060          ENDIF
    1049           IF (SIZE(field) == klon) then
     1061         
     1062          IF (grid_type==regular_lonlat) THEN
     1063            IF (SIZE(field) == klon) then
    10501064              CALL xios_send_field(var%name, Field2d)
    1051           ELSE
    1052              CALL xios_send_field(var%name, field)
    1053           ENDIF
     1065            ELSE
     1066               CALL xios_send_field(var%name, field)
     1067            ENDIF
     1068          ELSE IF (grid_type==unstructured) THEN
     1069            CALL xios_send_field(var%name, buffer_omp)
     1070          ENDIF
    10541071          IF (prt_level >= 10) THEN
    1055              WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name)                       
     1072             write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
     1073                             trim(var%name)                       
    10561074          ENDIF
    10571075#else
    … …  
    10651083               IF (firstx) THEN
    10661084                  IF (prt_level >= 10) THEN
    1067                      WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name)                       
    1068                      WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
     1085                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
     1086                                    iff,trim(var%name)                       
     1087                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
    10691088                  ENDIF
    1070                   IF (SIZE(field) == klon) then
    1071                      CALL xios_send_field(var%name, Field2d)
    1072                   ELSE
    1073                      CALL xios_send_field(var%name, field)
     1089                  IF (grid_type==regular_lonlat) THEN
     1090                    IF (SIZE(field) == klon) then
     1091                       CALL xios_send_field(var%name, Field2d)
     1092                    ELSE
     1093                       CALL xios_send_field(var%name, field)
     1094                    ENDIF
     1095                  ELSE IF (grid_type==unstructured) THEN
     1096                    CALL xios_send_field(var%name, buffer_omp)
    10741097                  ENDIF
     1098
    10751099                  firstx=.false.
    10761100               ENDIF
    … …  
    10851109!#ifdef CPP_XIOS
    10861110!                        IF (iff == iff_beg) THEN
    1087 !                          if (prt_level >= 10) then
     1111!                          IF (prt_level >= 10) THEN
    10881112!                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
    1089 !                          endif
     1113!                          ENDIF
    10901114!                          CALL xios_send_field(var%name, Field2d)
    10911115!                        ENDIF
    … …  
    11091133                       ENDIF ! of IF (is_sequential)
    11101134#ifndef CPP_IOIPSL_NO_OUTPUT
    1111                        IF (prt_level >= 10) THEn
     1135                       IF (prt_level >= 10) THEN
    11121136                         write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
    11131137                       ENDIF
    … …  
    11411165                                 nfiles, vars_defined, clef_stations, &
    11421166                                 nid_files, swaerofree_diag
    1143   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     1167  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
    11441168#ifdef CPP_XIOS
    11451169  USE xios, ONLY: xios_send_field
    … …  
    12061230    ENDIF
    12071231!$OMP MASTER
    1208     CALL grid1Dto2D_mpi(buffer_omp,field3d)
     1232    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
    12091233
    12101234! BOUCLE SUR LES FICHIERS
    … …  
    12131237    IF (ok_all_xml) THEN
    12141238#ifdef CPP_XIOS
    1215         IF (prt_level >= 10) THEN
    1216              write(lunout,*)'Dans iophy histwrite3D,var%name ',trim(var%name)                       
     1239          IF (prt_level >= 10) THEN
     1240             write(lunout,*)'Dans iophy histwrite3D,var%name ',&
     1241                             trim(var%name)                       
     1242          ENDIF
     1243          IF (grid_type==regular_lonlat) THEN
     1244            IF (SIZE(field,1) == klon) then
     1245               CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1246            ELSE
     1247               CALL xios_send_field(var%name, field)
     1248            ENDIF
     1249          ELSE IF (grid_type==unstructured) THEN
     1250            CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
    12171251        ENDIF
    1218         IF (SIZE(field,1) == klon) then
    1219              CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1220         ELSE
    1221              CALL xios_send_field(var%name, field)
    1222         ENDIF
     1252
    12231253#else
    12241254        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    … …  
    12301260#ifdef CPP_XIOS
    12311261              IF (firstx) THEN
    1232                 IF (prt_level >= 10) THEn
    1233                   WRITE (lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
     1262                IF (prt_level >= 10) THEN
     1263                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
    12341264                                  iff,nlev,klev, firstx                       
    1235                   WRITE (lunout,*)'histwrite3d_phy: call xios_send_field for ', &
     1265                  write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
    12361266                                  trim(var%name), ' with iim jjm nlevx = ', &
    12371267                                  nbp_lon,jj_nb,nlevx
    12381268                ENDIF
    1239                 IF (SIZE(field,1) == klon) then
    1240                     CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1241                 ELSE
    1242                      CALL xios_send_field(var%name, field)
     1269                IF (grid_type==regular_lonlat) THEN
     1270                  IF (SIZE(field,1) == klon) then
     1271                      CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1272                  ELSE
     1273                       CALL xios_send_field(var%name, field)
     1274                  ENDIF
     1275                ELSE IF (grid_type==unstructured) THEN
     1276                  CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
    12431277                ENDIF
     1278
    12441279                firstx=.false.
    12451280              ENDIF
    … …  
    13051340                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    13061341                                jj_nb, klon_mpi, is_master
    1307   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     1342  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
    13081343  USE xios, ONLY: xios_send_field
    13091344  USE print_control_mod, ONLY: prt_level,lunout
    … …  
    13351370        CALL Gather_omp(field,buffer_omp)   
    13361371!$OMP MASTER
     1372
     1373      IF (grid_type==unstructured) THEN
     1374 
     1375        CALL xios_send_field(field_name, buffer_omp)
     1376
     1377      ELSE
     1378
    13371379        CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    13381380   
    … …  
    13421384    !IF(.NOT.clef_stations(iff)) THEN
    13431385        IF (.TRUE.) THEN
    1344             ALLOCATE(index2d(nbp_lon*jj_nb))
    1345             ALLOCATE(fieldok(nbp_lon*jj_nb))
    1346    
    13471386   
    13481387            CALL xios_send_field(field_name, Field2d)
    … …  
    13651404                ENDDO
    13661405            ENDIF
    1367    
    1368         ENDIF
    1369                  
    1370         DEALLOCATE(index2d)
    1371         DEALLOCATE(fieldok)
     1406            DEALLOCATE(index2d)
     1407            DEALLOCATE(fieldok)
     1408   
     1409        ENDIF                 
     1410      ENDIF
    13721411!$OMP END MASTER   
    13731412  ENDIF
    … …  
    13851424                                jj_nb, klon_mpi, is_master
    13861425  USE xios, ONLY: xios_send_field
    1387   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     1426  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
    13881427  USE print_control_mod, ONLY: prt_level,lunout
    13891428
    … …  
    14161455        CALL Gather_omp(field,buffer_omp)
    14171456!$OMP MASTER
     1457
     1458    IF (grid_type==unstructured) THEN
     1459
     1460      CALL xios_send_field(field_name, buffer_omp(:,1:nlev))
     1461
     1462    ELSE
    14181463        CALL grid1Dto2D_mpi(buffer_omp,field3d)
    14191464
    … …  
    14231468    !IF (.NOT.clef_stations(iff)) THEN
    14241469        IF(.TRUE.)THEN
    1425             ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    1426             ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    1427             CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
     1470
     1471           CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
    14281472                           
    14291473        ELSE
    … …  
    14481492                ENDDO
    14491493            ENDIF
     1494            DEALLOCATE(index3d)
     1495            DEALLOCATE(fieldok)
    14501496        ENDIF
    1451         DEALLOCATE(index3d)
    1452         DEALLOCATE(fieldok)
     1497      ENDIF
    14531498!$OMP END MASTER   
    14541499  ENDIF

  • LMDZ6/trunk/libf/phylmd/iostart.F90

    r3401 r3435  
    117117  USE netcdf
    118118  USE dimphy
     119  USE geometry_mod
    119120  USE mod_grid_phy_lmdz
    120121  USE mod_phys_lmdz_para
    … …  
    126127   
    127128    REAL    :: field_glo(klon_glo,field_size)
     129    REAL    :: field_glo_tmp(klon_glo,field_size)
     130    INTEGER :: ind_cell_glo_glo(klon_glo)
    128131    LOGICAL :: tmp_found
    129132    INTEGER :: varid
    130     INTEGER :: ierr
    131    
    132     IF (is_mpi_root .AND. is_omp_root) THEN
     133    INTEGER :: ierr,i
     134
     135!    IF (is_master) ALLOCATE(ind_cell_glo_glo(1:klon_glo))
     136    CALL gather(ind_cell_glo,ind_cell_glo_glo)
     137   
     138    IF (is_master) THEN
    133139 
    134140      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
    135141     
    136142      IF (ierr==NF90_NOERR) THEN
    137         CALL body(field_glo)
     143        CALL body(field_glo_tmp)
    138144        tmp_found=.TRUE.
    139145      ELSE
    … …  
    146152
    147153    IF (tmp_found) THEN
     154      IF (is_master) THEN 
     155        DO i=1,klon_glo
     156         field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:)
     157        ENDDO
     158      ENDIF
    148159      CALL scatter(field_glo,field)
    149160    ENDIF
    … …  
    358369  USE netcdf
    359370  USE dimphy
     371  USE geometry_mod
    360372  USE mod_grid_phy_lmdz
    361373  USE mod_phys_lmdz_para
    … …  
    367379 
    368380  REAL                           :: field_glo(klon_glo,field_size)
    369   INTEGER                        :: ierr
     381  REAL                           :: field_glo_tmp(klon_glo,field_size)
     382!  INTEGER,ALLOCATABLE            :: ind_cell_glo_glo(:)
     383  INTEGER                        :: ind_cell_glo_glo(klon_glo)
     384  INTEGER                        :: ierr,i
    370385  INTEGER                        :: nvarid
    371386  INTEGER                        :: idim
    372387   
    373388   
    374     CALL gather(field,field_glo)
    375    
    376     IF (is_mpi_root .AND. is_omp_root) THEN
     389!    IF (is_master) ALLOCATE(ind_cell_glo_glo(klon_glo))
     390    CALL gather(ind_cell_glo,ind_cell_glo_glo)
     391
     392    CALL gather(field,field_glo_tmp)
     393   
     394    IF (is_master) THEN
     395
     396      DO i=1,klon_glo
     397       field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:)
     398      ENDDO
     399
    377400
    378401      IF (field_size==1) THEN

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

    r2788 r3435  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44MODULE limit_read_mod
    … …  
    3131!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3232
     33
     34  SUBROUTINE init_limit_read(first_day)
     35  USE mod_grid_phy_lmdz
     36  USE surface_data
     37  USE mod_phys_lmdz_para
     38#ifdef CPP_XIOS
     39  USE XIOS
     40#endif
     41  IMPLICIT NONE
     42    INTEGER, INTENT(IN) :: first_day
     43   
     44   
     45    IF ( type_ocean /= 'couple') THEN
     46      IF (grid_type==unstructured) THEN
     47#ifdef CPP_XIOS
     48        IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day)
     49#endif
     50      ENDIF 
     51    ENDIF
     52
     53  END SUBROUTINE init_limit_read
     54 
    3355  SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified)
    3456!
    … …  
    150172    USE phys_cal_mod, ONLY : calend, year_len
    151173    USE print_control_mod, ONLY: lunout, prt_level
    152 
     174#ifdef CPP_XIOS
     175    USE XIOS, ONLY: xios_recv_field
     176#endif
     177   
    153178    IMPLICIT NONE
    154179   
    … …  
    179204    REAL, DIMENSION(klon_glo)                 :: rug_glo  ! rugosity at global grid
    180205    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
     206
     207    REAL, DIMENSION(klon_mpi,nbsrf)           :: pct_mpi  ! fraction at global grid
     208    REAL, DIMENSION(klon_mpi)                 :: sst_mpi  ! sea-surface temperature at global grid
     209    REAL, DIMENSION(klon_mpi)                 :: rug_mpi  ! rugosity at global grid
     210    REAL, DIMENSION(klon_mpi)                 :: alb_mpi  ! albedo at global grid
     211
    181212    CHARACTER(len=20)                         :: modname='limit_read_mod'     
    182213    CHARACTER(LEN=99)                         :: abort_message, calendar, str
    … …  
    220251          END IF
    221252
    222           !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS
    223           ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
     253          !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS         
     254          IF (grid_type==unstructured) THEN
     255            ierr=NF90_INQ_DIMID(nid,"time_year",ndimid)
     256          ELSE
     257            ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
     258          ENDIF
    224259          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
    225           WRITE(abort_message,'(a,2(i3,a))')'limit.nc records number (',nn,') does no'//&
     260          WRITE(abort_message,'(a,2(i0,a))')'limit.nc records number (',nn,') does no'//&
    226261            't match year length (',year_len,')'
    227262          IF(nn/=year_len) CALL abort_physic(modname,abort_message,1)
    228263
    229264          !--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
    230           ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
     265          IF (grid_type==unstructured) THEN
     266            ierr=NF90_INQ_DIMID(nid, 'cell', ndimid)
     267          ELSE
     268            ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
     269          ENDIF
    231270          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
    232271          WRITE(abort_message,'(a,2(i0,a))')'limit.nc horizontal number of cells (',nn, &
    … …  
    249288
    250289    is_modified = .FALSE.
    251     IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN   ! time to read
     290!ym    IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN   ! time to read
     291!  not REALLY PERIODIC
     292    IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN   ! time to read
     293!    IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
    252294       jour_lu = jour
    253295       is_modified = .TRUE.
     296
     297      IF (grid_type==unstructured) THEN
     298
     299#ifdef CPP_XIOS
     300        IF ( type_ocean /= 'couple') THEN
     301
     302           IF (is_omp_master) CALL xios_recv_field("foce_limin",pct_mpi(:,is_oce))
     303           IF (is_omp_master) CALL xios_recv_field("fsic_limin",pct_mpi(:,is_sic))
     304  !         IF (read_continents .OR. itime == 1) THEN
     305           IF (is_omp_master) CALL xios_recv_field("fter_limin",pct_mpi(:,is_ter))
     306           IF (is_omp_master) CALL xios_recv_field("flic_limin",pct_mpi(:,is_lic))
     307  !         ENDIF
     308         ENDIF! type_ocean /= couple
     309         
     310         IF ( type_ocean /= 'couple') THEN                   
     311             IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi)
     312         ENDIF
     313       
     314         IF (.NOT. ok_veget) THEN
     315           IF (is_omp_master) CALL xios_recv_field("alb_limin",alb_mpi)
     316           IF (is_omp_master) CALL xios_recv_field("rug_limin",rug_mpi)
     317         ENDIF
     318
     319       IF ( type_ocean /= 'couple') THEN
     320          CALL Scatter_omp(sst_mpi,sst)
     321          CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
     322          CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
     323!          IF (read_continents .OR. itime == 1) THEN
     324             CALL Scatter_omp(pct_mpi(:,is_ter),pctsrf(:,is_ter))
     325             CALL Scatter_omp(pct_mpi(:,is_lic),pctsrf(:,is_lic))
     326!          END IF
     327       END IF
     328
     329       IF (.NOT. ok_veget) THEN
     330          CALL Scatter_omp(alb_mpi, albedo)
     331          CALL Scatter_omp(rug_mpi, rugos)
     332       END IF
     333#endif
     334
     335 
     336     ELSE      ! grid_type==regular
     337
    254338!$OMP MASTER  ! Only master thread
    255        IF (is_mpi_root) THEN ! Only master processus
     339       IF (is_mpi_root) THEN ! Only master processus!
    256340
    257341          ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)
    … …  
    371455       END IF
    372456
     457      ENDIF ! Grid type
     458
    373459    ENDIF ! time to read
    374460

  • LMDZ6/trunk/libf/phylmd/moy_undefSTD.F90

    r2380 r3435  
    7575
    7676    IF (n==1 .AND. itap==itapm1 .OR. n>1 .AND. mod(itap,nint(freq_outnmc(n)/ &
    77         dtime))==0) THEN
     77        phys_tstep))==0) THEN
    7878
    7979      ! print*,'moy_undefSTD n itap itapm1',n,itap,itapm1
    … …  
    140140        END DO !i
    141141      END DO !k
    142     END IF !MOD(itap,NINT(freq_outNMC(n)/dtime)).EQ.0
     142    END IF !MOD(itap,NINT(freq_outNMC(n)/phys_tstep)).EQ.0
    143143
    144144  END DO !n

  • LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

    r3402 r3435  
    5959    USE print_control_mod, ONLY: lunout
    6060    USE ioipsl_getin_p_mod, ONLY : getin_p
     61    IMPLICIT NONE
    6162
    6263    INCLUDE "dimsoil.h"
    … …  
    287288    USE indice_sol_mod
    288289    USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
    289     USE mod_grid_phy_lmdz,  ONLY : nbp_lon, nbp_lat
     290    USE mod_grid_phy_lmdz,  ONLY : nbp_lon, nbp_lat, grid1dto2d_glo
    290291    USE print_control_mod,  ONLY : prt_level,lunout
    291292    USE ioipsl_getin_p_mod, ONLY : getin_p
    … …  
    852853          idayref = day_ini
    853854          CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
    854           CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon,zx_lon)
     855          CALL grid1dTo2d_glo(rlon,zx_lon)
    855856          DO i = 1, nbp_lon
    856857             zx_lon(i,1) = rlon(i+1)
    857858             zx_lon(i,nbp_lat) = rlon(i+1)
    858859          ENDDO
    859           CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat,zx_lat)
     860          CALL grid1dTo2d_glo(rlat,zx_lat)
    860861          CALL histbeg("sous_index",nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:), &
    861862               1,nbp_lon,1,nbp_lat, &
    … …  
    19271928               itap, dtime, jour, knon, ni, &
    19281929!!jyg               ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    1929                ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&
     1930               ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&    ! ym missing init
    19301931               AcoefH, AcoefQ, BcoefH, BcoefQ, &
    19311932               AcoefU, AcoefV, BcoefU, BcoefV, &

  • LMDZ6/trunk/libf/phylmd/phyaqua_mod.F90

    r3401 r3435  
    2929    USE indice_sol_mod
    3030    USE nrtype, ONLY: pi
    31     USE ioipsl
     31!    USE ioipsl
     32    USE mod_phys_lmdz_para, ONLY: is_master
     33    USE mod_phys_lmdz_transfert_para, ONLY: bcast
     34    USE mod_grid_phy_lmdz
     35    USE ioipsl_getin_p_mod, ONLY : getin_p
    3236    IMPLICIT NONE
    3337
    … …  
    5761    INTEGER it, unit, i, k, itap
    5862
    59     REAL airefi, zcufi, zcvfi
    60 
    6163    REAL rugos, albedo
    6264    REAL tsurf
    … …  
    6466    REAL qsol_f
    6567    REAL rugsrel(nlon)
    66     ! real zmea(nlon),zstd(nlon),zsig(nlon)
    67     ! real zgam(nlon),zthe(nlon),zpic(nlon),zval(nlon)
    68     ! real rlon(nlon),rlat(nlon)
    6968    LOGICAL alb_ocean
    70     ! integer demih_pas
    7169
    7270    CHARACTER *80 ans, file_forctl, file_fordat, file_start
    … …  
    8684
    8785    INTEGER, SAVE :: read_climoz = 0 ! read ozone climatology
    88 
    89     ! intermediate variables to use getin (need to be "save" to be shared by
    90     ! all threads)
    91     INTEGER, SAVE :: nbapp_rad_omp
    92     REAL, SAVE :: co2_ppm_omp, solaire_omp
    93     LOGICAL, SAVE :: alb_ocean_omp
    94     REAL, SAVE :: rugos_omp
     86!$OMP THREADPRIVATE(read_climoz)
     87
    9588    ! -------------------------------------------------------------------------
    9689    ! declaration pour l'appel a phyredem
    … …  
    117110    INTEGER l, ierr, aslun
    118111
    119 !    REAL longitude, latitude
    120112    REAL paire
    121113
    122 !    DATA latitude, longitude/48., 0./
    123114
    124115    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    148139    time = 0.
    149140
    150     ! IM ajout latfi, lonfi
    151 !    rlatd = latfi
    152 !    rlond = lonfi
    153 !    rlat = rlatd*180./pi
    154 !    rlon = rlond*180./pi
    155 
    156141    ! -----------------------------------------------------------------------
    157142    ! initialisations de la physique
    … …  
    160145    day_ini = day_ref
    161146    day_end = day_ini + ndays
    162 !    airefi = 1.
    163 !    zcufi = 1.
    164 !    zcvfi = 1.
    165     !$OMP MASTER
    166     nbapp_rad_omp = 24
    167     CALL getin('nbapp_rad', nbapp_rad_omp)
    168     !$OMP END MASTER
    169     !$OMP BARRIER
    170     nbapp_rad = nbapp_rad_omp
     147
     148    nbapp_rad = 24
     149    CALL getin_p('nbapp_rad', nbapp_rad)
    171150
    172151    ! ---------------------------------------------------------------------
    … …  
    175154    ! Initialisations des constantes
    176155    ! Ajouter les manquants dans planete.def... (albedo etc)
    177     !$OMP MASTER
    178     co2_ppm_omp = 348.
    179     CALL getin('co2_ppm', co2_ppm_omp)
    180     solaire_omp = 1365.
    181     CALL getin('solaire', solaire_omp)
     156    co2_ppm = 348.
     157    CALL getin_p('co2_ppm', co2_ppm)
     158
     159    solaire = 1365.
     160    CALL getin_p('solaire', solaire)
     161 
    182162    ! CALL getin('albedo',albedo) ! albedo is set below, depending on
    183163    ! type_aqua
    184     alb_ocean_omp = .TRUE.
    185     CALL getin('alb_ocean', alb_ocean_omp)
    186     !$OMP END MASTER
    187     !$OMP BARRIER
    188     co2_ppm = co2_ppm_omp
     164    alb_ocean = .TRUE.
     165    CALL getin_p('alb_ocean', alb_ocean)
     166
    189167    WRITE (*, *) 'iniaqua: co2_ppm=', co2_ppm
    190     solaire = solaire_omp
    191168    WRITE (*, *) 'iniaqua: solaire=', solaire
    192     alb_ocean = alb_ocean_omp
    193169    WRITE (*, *) 'iniaqua: alb_ocean=', alb_ocean
    194170
    … …  
    226202    END IF
    227203
    228     !$OMP MASTER
    229     rugos_omp = rugos
    230     CALL getin('rugos', rugos_omp)
    231     !$OMP END MASTER
    232     !$OMP BARRIER
    233     rugos = rugos_omp
     204    CALL getin_p('rugos', rugos)
     205
    234206    WRITE (*, *) 'iniaqua: rugos=', rugos
    235207    zmasq(:) = pctsrf(:, is_ter)
    … …  
    262234    CALL profil_sst(nlon, latitude, type_profil, phy_sst)
    263235
    264     CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
    265       phy_fter, phy_foce, phy_flic, phy_fsic)
    266 
     236    IF (grid_type==unstructured) THEN
     237      CALL writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     238                             phy_fter, phy_foce, phy_flic, phy_fsic)
     239    ELSE
     240     
     241       CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, &
     242                     phy_fter, phy_foce, phy_flic, phy_fsic)
     243    ENDIF
    267244
    268245    ! ---------------------------------------------------------------------
    … …  
    339316    PRINT *, 'iniaqua: before phyredem'
    340317
    341     pbl_tke(:,:,:)=1.e-8
     318    pbl_tke(:,:,:) = 1.e-8
    342319    falb1 = albedo
    343320    falb2 = albedo
    … …  
    349326    wake_deltaq = 0.
    350327    wake_s = 0.
    351     wake_dens = 0. 
     328    wake_dens = 0.
    352329    wake_cstar = 0.
    353330    wake_pe = 0.
    … …  
    360337    alp_bl =0.
    361338    treedrg(:,:,:)=0.
     339
     340!ym error : the sub surface dimension is the third not second : forgotten for iniaqua
     341!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
     342!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
     343    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
     344    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
     345
     346!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
     347!ym probably the uninitialized value was 0 for standard (regular grid) case
     348    falb_dif(:,:,:)=0
    362349
    363350
    … …  
    488475  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    489476
    490   SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
     477  SUBROUTINE writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
    491478      phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
    492479
    493     USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
    494     USE mod_grid_phy_lmdz, ONLY: klon_glo
    495     USE mod_phys_lmdz_transfert_para, ONLY: gather
     480    USE mod_phys_lmdz_para, ONLY: is_omp_master, klon_mpi
     481    USE mod_phys_lmdz_transfert_para, ONLY: gather_omp
     482#ifdef CPP_XIOS
     483    USE xios
     484#endif
    496485    IMPLICIT NONE
     486
    497487    include "netcdf.inc"
    498488
    … …  
    509499    REAL, INTENT (IN) :: phy_fsic(klon, 360)
    510500
     501    REAL :: phy_mpi(klon_mpi, 360) ! temporary variable, to store phy_***(:)
     502      ! on the whole physics grid
     503 
     504#ifdef CPP_XIOS
     505    PRINT *, 'writelim: Ecriture du fichier limit'
     506
     507    CALL gather_omp(phy_foce, phy_mpi)
     508    IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi)
     509
     510    CALL gather_omp(phy_fsic, phy_mpi)
     511    IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi)
     512     
     513    CALL gather_omp(phy_fter, phy_mpi)
     514    IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi)
     515     
     516    CALL gather_omp(phy_flic, phy_mpi)
     517    IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi)
     518
     519    CALL gather_omp(phy_sst, phy_mpi)
     520    IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi)
     521
     522    CALL gather_omp(phy_bil, phy_mpi)
     523    IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi)
     524
     525    CALL gather_omp(phy_alb, phy_mpi)
     526    IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi)
     527
     528    CALL gather_omp(phy_rug, phy_mpi)
     529    IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi)
     530#endif
     531  END SUBROUTINE writelim_unstruct
     532
     533
     534
     535  SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &
     536      phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic)
     537
     538    USE mod_phys_lmdz_para, ONLY: is_master
     539    USE mod_grid_phy_lmdz, ONLY: klon_glo
     540    USE mod_phys_lmdz_transfert_para, ONLY: gather
     541    IMPLICIT NONE
     542    include "netcdf.inc"
     543
     544    INTEGER, INTENT (IN) :: klon
     545    REAL, INTENT (IN) :: phy_nat(klon, 360)
     546    REAL, INTENT (IN) :: phy_alb(klon, 360)
     547    REAL, INTENT (IN) :: phy_sst(klon, 360)
     548    REAL, INTENT (IN) :: phy_bil(klon, 360)
     549    REAL, INTENT (IN) :: phy_rug(klon, 360)
     550    REAL, INTENT (IN) :: phy_ice(klon, 360)
     551    REAL, INTENT (IN) :: phy_fter(klon, 360)
     552    REAL, INTENT (IN) :: phy_foce(klon, 360)
     553    REAL, INTENT (IN) :: phy_flic(klon, 360)
     554    REAL, INTENT (IN) :: phy_fsic(klon, 360)
     555
    511556    REAL :: phy_glo(klon_glo, 360) ! temporary variable, to store phy_***(:)
    512557      ! on the whole physics grid
    … …  
    522567    INTEGER id_fter, id_foce, id_fsic, id_flic
    523568
    524     IF (is_mpi_root .AND. is_omp_root) THEN
     569    IF (is_master) THEN
    525570
    526571      PRINT *, 'writelim: Ecriture du fichier limit'
    … …  
    627672      END DO
    628673
    629     END IF ! of if (is_mpi_root.and.is_omp_root)
     674    END IF ! of if (is_master)
    630675
    631676    ! write the fields, after having collected them on master
    632677
    633678    CALL gather(phy_nat, phy_glo)
    634     IF (is_mpi_root .AND. is_omp_root) THEN
     679    IF (is_master) THEN
    635680#ifdef NC_DOUBLE
    636681      ierr = nf_put_var_double(nid, id_nat, phy_glo)
    … …  
    645690
    646691    CALL gather(phy_sst, phy_glo)
    647     IF (is_mpi_root .AND. is_omp_root) THEN
     692    IF (is_master) THEN
    648693#ifdef NC_DOUBLE
    649694      ierr = nf_put_var_double(nid, id_sst, phy_glo)
    … …  
    658703
    659704    CALL gather(phy_bil, phy_glo)
    660     IF (is_mpi_root .AND. is_omp_root) THEN
     705    IF (is_master) THEN
    661706#ifdef NC_DOUBLE
    662707      ierr = nf_put_var_double(nid, id_bils, phy_glo)
    … …  
    671716
    672717    CALL gather(phy_alb, phy_glo)
    673     IF (is_mpi_root .AND. is_omp_root) THEN
     718    IF (is_master) THEN
    674719#ifdef NC_DOUBLE
    675720      ierr = nf_put_var_double(nid, id_alb, phy_glo)
    … …  
    684729
    685730    CALL gather(phy_rug, phy_glo)
    686     IF (is_mpi_root .AND. is_omp_root) THEN
     731    IF (is_master) THEN
    687732#ifdef NC_DOUBLE
    688733      ierr = nf_put_var_double(nid, id_rug, phy_glo)
    … …  
    697742
    698743    CALL gather(phy_fter, phy_glo)
    699     IF (is_mpi_root .AND. is_omp_root) THEN
     744    IF (is_master) THEN
    700745#ifdef NC_DOUBLE
    701746      ierr = nf_put_var_double(nid, id_fter, phy_glo)
    … …  
    710755
    711756    CALL gather(phy_foce, phy_glo)
    712     IF (is_mpi_root .AND. is_omp_root) THEN
     757    IF (is_master) THEN
    713758#ifdef NC_DOUBLE
    714759      ierr = nf_put_var_double(nid, id_foce, phy_glo)
    … …  
    723768
    724769    CALL gather(phy_fsic, phy_glo)
    725     IF (is_mpi_root .AND. is_omp_root) THEN
     770    IF (is_master) THEN
    726771#ifdef NC_DOUBLE
    727772      ierr = nf_put_var_double(nid, id_fsic, phy_glo)
    … …  
    736781
    737782    CALL gather(phy_flic, phy_glo)
    738     IF (is_mpi_root .AND. is_omp_root) THEN
     783    IF (is_master) THEN
    739784#ifdef NC_DOUBLE
    740785      ierr = nf_put_var_double(nid, id_flic, phy_glo)
    … …  
    749794
    750795    ! close file:
    751     IF (is_mpi_root .AND. is_omp_root) THEN
     796    IF (is_master) THEN
    752797      ierr = nf_close(nid)
    753798    END IF

  • LMDZ6/trunk/libf/phylmd/phyetat0.F90

    r3422 r3435  
    99  USE pbl_surface_mod,  ONLY : pbl_surface_init
    1010  USE surface_data,     ONLY : type_ocean, version_ocean
    11   USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, dtime, &
     11  USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, &
    1212       qsol, fevap, z0m, z0h, agesno, &
    1313       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
    … …  
    472472
    473473  IF ( type_ocean == 'slab' ) THEN
    474       CALL ocean_slab_init(dtime, pctsrf)
     474      CALL ocean_slab_init(phys_tstep, pctsrf)
    475475      IF (nslay.EQ.1) THEN
    476476        found=phyetat0_get(1,tslab,"tslab01","tslab",0.)
    … …  
    521521  ! Initialize module ocean_cpl_mod for the case of coupled ocean
    522522  IF ( type_ocean == 'couple' ) THEN
    523      CALL ocean_cpl_init(dtime, longitude_deg, latitude_deg)
    524   ENDIF
    525 
    526   CALL init_iophy_new(latitude_deg, longitude_deg)
     523     CALL ocean_cpl_init(phys_tstep, longitude_deg, latitude_deg)
     524  ENDIF
     525
     526!  CALL init_iophy_new(latitude_deg, longitude_deg)
    527527
    528528  ! Initilialize module fonte_neige_mod     

  • LMDZ6/trunk/libf/phylmd/phys_cal_mod.F90

    r2802 r3435  
    1 ! $Id:$
     1! $Id$
    22MODULE phys_cal_mod
    33! This module contains information on the calendar at the current time step
    … …  
    3737  SUBROUTINE phys_cal_init(annee_ref,day_ref)
    3838
    39     USE IOIPSL, ONLY:  ymds2ju
     39    USE IOIPSL, ONLY:  ymds2ju, ioconf_calendar
     40    USE mod_phys_lmdz_para, ONLY:  is_master,is_omp_master
    4041    USE ioipsl_getin_p_mod, ONLY: getin_p
    4142
    … …  
    4748    calend = 'earth_360d' ! default
    4849    CALL getin_p("calend",calend)
     50
     51    IF (is_omp_master) THEN
     52      IF (calend == 'earth_360d') THEN
     53        CALL ioconf_calendar('360d')
     54      ELSE IF (calend == 'earth_365d') THEN
     55        CALL ioconf_calendar('noleap')
     56      ELSE IF (calend == 'earth_366d') THEN
     57        CALL ioconf_calendar('gregorian')
     58      ELSE
     59        CALL abort_physic('phys_cal_init','Mauvais choix de calendrier',1)
     60      ENDIF
     61    ENDIF
     62!$OMP BARRIER
    4963     
    5064    CALL ymds2ju(annee_ref, 1, day_ref, 0., jD_ref)

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

    r3379 r3435  
    343343!$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w)
    344344!jyg<
    345 !!! Entr\E9es suppl\E9mentaires couche-limite
     345!!! Entrees supplementaires couche-limite
    346346!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_x, t_w
    347347!!!$OMP THREADPRIVATE(t_x, t_w)
    … …  
    349349!!!$OMP THREADPRIVATE(q_x, q_w)
    350350!>jyg
    351 ! Variables suppl\E9mentaires dans physiq.F relative au splitting de la surface
     351!!! Sorties ferret
     352      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dtvdf_x, dtvdf_w
     353!$OMP THREADPRIVATE(dtvdf_x, dtvdf_w)
     354      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w
     355!$OMP THREADPRIVATE(dqvdf_x, dqvdf_w)
     356! Variables supplementaires dans physiq.F relative au splitting de la surface
    352357      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input
    353358!$OMP THREADPRIVATE(pbl_tke_input)
    … …  
    578583      ALLOCATE(plul_st(klon),plul_th(klon))
    579584      ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
     585
     586      ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
     587      ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
     588
    580589      ALLOCATE(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
    581590      ALLOCATE(d_t_oli(klon,klev),d_t_oro(klon,klev))
    … …  
    589598! Special RRTM
    590599      ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
     600      ZFLDN0= 0.
    591601      ALLOCATE(ZFLUP0(klon,klev+1),ZFSDN0(klon,klev+1),ZFSUP0(klon,klev+1))
    592602!
    … …  
    603613      ALLOCATE(dv_gwd_rando(klon,klev),dv_gwd_front(klon,klev))
    604614      ALLOCATE(east_gwstress(klon,klev),west_gwstress(klon,klev))
     615      east_gwstress(:,:)=0 !ym missing init
     616      west_gwstress(:,:)=0 !ym missing init
    605617      ALLOCATE(d_t_hin(klon,klev))
    606618      ALLOCATE(d_q_ch4(klon,klev))
    … …  
    627639      ALLOCATE(od865aer(klon))
    628640      ALLOCATE(dryod550aer(klon))
     641      dryod550aer(:) = 0.
    629642      ALLOCATE(abs550aer(klon))
     643      abs550aer(:) = 0.
    630644      ALLOCATE(ec550aer(klon,klev))
    631645      ALLOCATE(od550lt1aer(klon))
    … …  
    672686      ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon))
    673687
    674 ! FH Ajout de celles n??cessaires au phys_output_write_mod
     688! FH Ajout de celles necessaires au phys_output_write_mod
    675689
    676690      ALLOCATE(tal1(klon), pal1(klon), pab1(klon), pab2(klon))
    … …  
    721735!!      ALLOCATE(q_x(klon,klev), q_w(klon,klev))
    722736!>jyg
    723       ALLOCATE(d_t_vdf_x(klon,klev), d_t_vdf_w(klon,klev))
    724       ALLOCATE(d_q_vdf_x(klon,klev), d_q_vdf_w(klon,klev))
     737      ALLOCATE(dtvdf_x(klon,klev), dtvdf_w(klon,klev))
     738      dtvdf_x = 0 ; dtvdf_w=0 ;   !ym missing init
     739      ALLOCATE(dqvdf_x(klon,klev), dqvdf_w(klon,klev))
     740      dqvdf_x = 0 ; dqvdf_w=0 ;   !ym missing init
    725741      ALLOCATE(pbl_tke_input(klon,klev+1,nbsrf))
    726742      ALLOCATE(t_therm(klon,klev), q_therm(klon,klev),u_therm(klon,klev), v_therm(klon,klev))
    … …  
    738754      ALLOCATE(sens(klon), flwp(klon), fiwp(klon))
    739755      ALLOCATE(alp_bl_conv(klon), alp_bl_det(klon))
     756      ale_bl_stat(:)=0 ; alp_bl_conv(:)=0 ;  alp_bl_det(:)=0
    740757      ALLOCATE(alp_bl_fluct_m(klon), alp_bl_fluct_tke(klon))
     758      alp_bl_fluct_m(:)=0 ; alp_bl_fluct_tke(:)= 0.
    741759      ALLOCATE(alp_bl_stat(klon), n2(klon), s2(klon))
     760      alp_bl_stat(:)=0
    742761      ALLOCATE(proba_notrig(klon), random_notrig(klon))
    743762      ALLOCATE(cv_gen(klon))
    … …  
    968987      DEALLOCATE(toplwad0_aerop, sollwad0_aerop)
    969988
    970 ! FH Ajout de celles n??cessaires au phys_output_write_mod
     989! FH Ajout de celles necessaires au phys_output_write_mod
    971990      DEALLOCATE(tal1, pal1, pab1, pab2)
    972991      DEALLOCATE(ptstar, pt0, slp)

  • LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

    r3381 r3435  
    367367    ! ug Pour les sorties XIOS
    368368    USE xios
    369     USE wxios, ONLY: wxios_closedef, missing_val
     369    USE wxios, ONLY: wxios_closedef, missing_val, wxios_set_context
    370370#endif
    371371    USE phys_cal_mod, ONLY : mth_len
    … …  
    437437    CALL set_itau_iophy(itau_w)
    438438
    439     IF (.NOT.vars_defined) THEN
    440        iinitend = 2
    441     ELSE
     439 !   IF (.NOT.vars_defined) THEN
    442440       iinitend = 1
    443     ENDIF
     441 !   ELSE
     442 !      iinitend = 1
     443 !   ENDIF
     444
     445#ifdef CPP_XIOS
     446    CALL wxios_set_context
     447#endif
    444448
    445449    DO ilev=1,klev
    … …  
    712716       CALL histwrite_phy(o_fsnow, zfra_o)
    713717       CALL histwrite_phy(o_evap, evap)
    714        CALL histwrite_phy(o_tops, topsw*swradcorr)
    715        CALL histwrite_phy(o_tops0, topsw0*swradcorr)
     718
     719       IF (vars_defined) THEN
     720         zx_tmp_fi2d = topsw*swradcorr
     721       ENDIF
     722       CALL histwrite_phy(o_tops, zx_tmp_fi2d)
     723
     724       IF (vars_defined) THEN
     725         zx_tmp_fi2d = topsw0*swradcorr
     726       ENDIF
     727       CALL histwrite_phy(o_tops0, zx_tmp_fi2d)
     728
    716729       CALL histwrite_phy(o_topl, toplw)
    717730       CALL histwrite_phy(o_topl0, toplw0)
    … …  
    746759       ENDIF
    747760       CALL histwrite_phy(o_nettop, zx_tmp_fi2d)
    748        CALL histwrite_phy(o_SWup200, SWup200*swradcorr)
    749        CALL histwrite_phy(o_SWup200clr, SWup200clr*swradcorr)
    750        CALL histwrite_phy(o_SWdn200, SWdn200*swradcorr)
    751        CALL histwrite_phy(o_SWdn200clr, SWdn200clr*swradcorr)
     761       
     762       IF (vars_defined) THEN
     763          zx_tmp_fi2d = SWup200*swradcorr
     764       ENDIF
     765       CALL histwrite_phy(o_SWup200, zx_tmp_fi2d)
     766       
     767       IF (vars_defined) THEN
     768          zx_tmp_fi2d = SWup200clr*swradcorr
     769       ENDIF
     770       CALL histwrite_phy(o_SWup200clr, zx_tmp_fi2d)
     771       
     772       IF (vars_defined) THEN
     773          zx_tmp_fi2d = SWdn200*swradcorr
     774       ENDIF
     775       CALL histwrite_phy(o_SWdn200, zx_tmp_fi2d)
     776       
     777       
     778       IF (vars_defined) THEN
     779          zx_tmp_fi2d = SWdn200clr*swradcorr
     780       ENDIF
     781       CALL histwrite_phy(o_SWdn200clr, zx_tmp_fi2d)
     782       
    752783       CALL histwrite_phy(o_LWup200, LWup200)
    753784       CALL histwrite_phy(o_LWup200clr, LWup200clr)
    754785       CALL histwrite_phy(o_LWdn200, LWdn200)
    755786       CALL histwrite_phy(o_LWdn200clr, LWdn200clr)
    756        CALL histwrite_phy(o_sols, solsw*swradcorr)
    757        CALL histwrite_phy(o_sols0, solsw0*swradcorr)
     787       
     788       IF (vars_defined) THEN
     789          zx_tmp_fi2d = solsw*swradcorr
     790       ENDIF
     791       CALL histwrite_phy(o_sols, zx_tmp_fi2d)
     792       
     793       
     794       IF (vars_defined) THEN
     795          zx_tmp_fi2d = solsw0*swradcorr
     796       ENDIF
     797       CALL histwrite_phy(o_sols0, zx_tmp_fi2d)
    758798       CALL histwrite_phy(o_soll, sollw)
    759799       CALL histwrite_phy(o_soll0, sollw0)
    … …  
    950990       CALL histwrite_phy(o_cldt, cldt)
    951991       CALL histwrite_phy(o_JrNt, JrNt)
    952        CALL histwrite_phy(o_cldljn, cldl*JrNt)
    953        CALL histwrite_phy(o_cldmjn, cldm*JrNt)
    954        CALL histwrite_phy(o_cldhjn, cldh*JrNt)
    955        CALL histwrite_phy(o_cldtjn, cldt*JrNt)
     992       
     993       IF (vars_defined)  zx_tmp_fi2d=cldl*JrNt     
     994       CALL histwrite_phy(o_cldljn, zx_tmp_fi2d)
     995       
     996       IF (vars_defined)  zx_tmp_fi2d=cldm*JrNt     
     997       CALL histwrite_phy(o_cldmjn, zx_tmp_fi2d)
     998       
     999       IF (vars_defined)  zx_tmp_fi2d=cldh*JrNt
     1000       CALL histwrite_phy(o_cldhjn, zx_tmp_fi2d)
     1001       
     1002       IF (vars_defined)  zx_tmp_fi2d=cldt*JrNt
     1003       CALL histwrite_phy(o_cldtjn, zx_tmp_fi2d)
     1004       
    9561005       CALL histwrite_phy(o_cldq, cldq)
    9571006       IF (vars_defined)       zx_tmp_fi2d(1:klon) = flwp(1:klon)
    … …  
    11541203             IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys
    11551204             CALL histwrite_phy(o_dqwak, zx_tmp_fi3d)
    1156              CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1205             IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    11571206             CALL histwrite_phy(o_dqwak2d, zx_tmp_fi2d)
    11581207          ENDIF ! iflag_wake>=1
    … …  
    13181367
    13191368! ThL -- In the following, we assume read_climoz == 1
    1320        zx_tmp_fi2d = 0.0    ! Computation for strato, added ThL
    1321        DO k=1, klev
    1322           zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * stratomask(:,k) * 1.e3
    1323        END DO
     1369       IF (vars_defined) THEN
     1370         zx_tmp_fi2d = 0.0    ! Computation for strato, added ThL
     1371         DO k=1, klev
     1372            zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * stratomask(:,k) * 1.e3
     1373         END DO
     1374       ENDIF
    13241375       CALL histwrite_phy(o_col_O3_strato, zx_tmp_fi2d) ! Added ThL
    1325        zx_tmp_fi2d = 0.0    ! Computation for tropo, added ThL
    1326        DO k=1, klev
    1327           zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * (1.0-stratomask(:,k)) * 1.e3
    1328        END DO
     1376
     1377       IF (vars_defined) THEN
     1378         zx_tmp_fi2d = 0.0    ! Computation for tropo, added ThL
     1379         DO k=1, klev
     1380            zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * (1.0-stratomask(:,k)) * 1.e3
     1381         END DO
     1382       ENDIF
    13291383       CALL histwrite_phy(o_col_O3_tropo, zx_tmp_fi2d)   ! Added ThL
    13301384! end add ThL
    … …  
    13671421#endif
    13681422       IF (ok_ade) THEN
    1369           CALL histwrite_phy(o_topswad, topswad_aero*swradcorr)
    1370           CALL histwrite_phy(o_topswad0, topswad0_aero*swradcorr)
    1371           CALL histwrite_phy(o_solswad, solswad_aero*swradcorr)
    1372           CALL histwrite_phy(o_solswad0, solswad0_aero*swradcorr)
     1423          IF (vars_defined) zx_tmp_fi2d(:)=topswad_aero*swradcorr
     1424          CALL histwrite_phy(o_topswad, zx_tmp_fi2d)
     1425         
     1426          IF (vars_defined) zx_tmp_fi2d(:)=topswad0_aero*swradcorr
     1427          CALL histwrite_phy(o_topswad0, zx_tmp_fi2d)
     1428                   
     1429          IF (vars_defined) zx_tmp_fi2d(:)=solswad_aero*swradcorr
     1430          CALL histwrite_phy(o_solswad, zx_tmp_fi2d)
     1431                   
     1432          IF (vars_defined) zx_tmp_fi2d(:)=solswad0_aero*swradcorr
     1433          CALL histwrite_phy(o_solswad0, zx_tmp_fi2d)
     1434         
    13731435          CALL histwrite_phy(o_toplwad, toplwad_aero)
    13741436          CALL histwrite_phy(o_toplwad0, toplwad0_aero)
    … …  
    13771439          !====MS forcing diagnostics
    13781440          IF (new_aod) THEN
    1379              zx_tmp_fi2d(:)=topsw_aero(:,1)*swradcorr(:)
     1441          !ym warning : topsw_aero, solsw_aero, topsw0_aero, solsw0_aero are not defined by model
     1442          !ym => init to 0 in radlwsw_m.F90 ztopsw_aero, zsolsw_aero, ztopsw0_aero, zsolsw0_aero
     1443
     1444             IF (vars_defined) zx_tmp_fi2d(:)=topsw_aero(:,1)*swradcorr(:)
    13801445             CALL histwrite_phy(o_swtoaas_nat,zx_tmp_fi2d)
    1381              zx_tmp_fi2d(:)=solsw_aero(:,1)*swradcorr(:)
     1446             IF (vars_defined) zx_tmp_fi2d(:)=solsw_aero(:,1)*swradcorr(:)
    13821447             CALL histwrite_phy(o_swsrfas_nat,zx_tmp_fi2d)
    1383              zx_tmp_fi2d(:)=topsw0_aero(:,1)*swradcorr(:)
     1448             IF (vars_defined) zx_tmp_fi2d(:)=topsw0_aero(:,1)*swradcorr(:)
    13841449             CALL histwrite_phy(o_swtoacs_nat,zx_tmp_fi2d)
    1385              zx_tmp_fi2d(:)=solsw0_aero(:,1)*swradcorr(:)
     1450             IF (vars_defined) zx_tmp_fi2d(:)=solsw0_aero(:,1)*swradcorr(:)
    13861451             CALL histwrite_phy(o_swsrfcs_nat,zx_tmp_fi2d)
    13871452             !ant
    1388              zx_tmp_fi2d(:)=topsw_aero(:,2)*swradcorr(:)
     1453             IF (vars_defined) zx_tmp_fi2d(:)=topsw_aero(:,2)*swradcorr(:)
    13891454             CALL histwrite_phy(o_swtoaas_ant,zx_tmp_fi2d)
    1390              zx_tmp_fi2d(:)=solsw_aero(:,2)*swradcorr(:)
     1455             IF (vars_defined) zx_tmp_fi2d(:)=solsw_aero(:,2)*swradcorr(:)
    13911456             CALL histwrite_phy(o_swsrfas_ant,zx_tmp_fi2d)
    1392              zx_tmp_fi2d(:)=topsw0_aero(:,2)*swradcorr(:)
     1457             IF (vars_defined) zx_tmp_fi2d(:)=topsw0_aero(:,2)*swradcorr(:)
    13931458             CALL histwrite_phy(o_swtoacs_ant,zx_tmp_fi2d)
    1394              zx_tmp_fi2d(:)=solsw0_aero(:,2)*swradcorr(:)
     1459             IF (vars_defined) zx_tmp_fi2d(:)=solsw0_aero(:,2)*swradcorr(:)
    13951460             CALL histwrite_phy(o_swsrfcs_ant,zx_tmp_fi2d)
    13961461             !cf
    13971462             IF (.not. aerosol_couple) THEN
    1398                 zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:)
     1463                IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:)
    13991464                CALL histwrite_phy(o_swtoacf_nat,zx_tmp_fi2d)
    1400                 zx_tmp_fi2d(:)=solswcf_aero(:,1)*swradcorr(:)
     1465                IF (vars_defined) zx_tmp_fi2d(:)=solswcf_aero(:,1)*swradcorr(:)
    14011466                CALL histwrite_phy(o_swsrfcf_nat,zx_tmp_fi2d)
    1402                 zx_tmp_fi2d(:)=topswcf_aero(:,2)*swradcorr(:)
     1467                IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,2)*swradcorr(:)
    14031468                CALL histwrite_phy(o_swtoacf_ant,zx_tmp_fi2d)
    1404                 zx_tmp_fi2d(:)=solswcf_aero(:,2)*swradcorr(:)
     1469                IF (vars_defined) zx_tmp_fi2d(:)=solswcf_aero(:,2)*swradcorr(:)
    14051470                CALL histwrite_phy(o_swsrfcf_ant,zx_tmp_fi2d)
    1406                 zx_tmp_fi2d(:)=topswcf_aero(:,3)*swradcorr(:)
     1471                IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,3)*swradcorr(:)
    14071472                CALL histwrite_phy(o_swtoacf_zero,zx_tmp_fi2d)
    1408                 zx_tmp_fi2d(:)=solswcf_aero(:,3)*swradcorr(:)
     1473                IF (vars_defined) zx_tmp_fi2d(:)=solswcf_aero(:,3)*swradcorr(:)
    14091474                CALL histwrite_phy(o_swsrfcf_zero,zx_tmp_fi2d)
    14101475             ENDIF
    … …  
    14131478       ENDIF
    14141479       IF (ok_aie) THEN
    1415           CALL histwrite_phy(o_topswai, topswai_aero*swradcorr)
    1416           CALL histwrite_phy(o_toplwai, toplwai_aero*swradcorr)
    1417           CALL histwrite_phy(o_solswai, solswai_aero*swradcorr)
    1418           CALL histwrite_phy(o_sollwai, sollwai_aero*swradcorr)
     1480          IF (vars_defined) zx_tmp_fi2d(:)= topswai_aero*swradcorr
     1481          CALL histwrite_phy(o_topswai, zx_tmp_fi2d)
     1482         
     1483          IF (vars_defined) zx_tmp_fi2d(:)=toplwai_aero*swradcorr
     1484          CALL histwrite_phy(o_toplwai, zx_tmp_fi2d)
     1485         
     1486          IF (vars_defined) zx_tmp_fi2d(:)=solswai_aero*swradcorr
     1487          CALL histwrite_phy(o_solswai, zx_tmp_fi2d)
     1488         
     1489          IF (vars_defined) zx_tmp_fi2d(:)=sollwai_aero*swradcorr
     1490          CALL histwrite_phy(o_sollwai, zx_tmp_fi2d)
    14191491       ENDIF
    14201492       IF (flag_aerosol.GT.0.AND.ok_cdnc) THEN
    … …  
    14461518       CALL histwrite_phy(o_ovap, q_seri)
    14471519       CALL histwrite_phy(o_oliq, ql_seri)
    1448        CALL histwrite_phy(o_ocond, ql_seri+qs_seri)
     1520
     1521       IF (vars_defined) zx_tmp_fi3d = ql_seri+qs_seri
     1522       CALL histwrite_phy(o_ocond, zx_tmp_fi3d)
     1523
    14491524       CALL histwrite_phy(o_geop, zphi)
    14501525       CALL histwrite_phy(o_vitu, u_seri)
    … …  
    14531528       CALL histwrite_phy(o_pres, pplay)
    14541529       CALL histwrite_phy(o_paprs, paprs(:,1:klev))
    1455        CALL histwrite_phy(o_zfull,zphi/RG)
     1530       
     1531       IF (vars_defined) zx_tmp_fi3d = zphi/RG
     1532       CALL histwrite_phy(o_zfull,zx_tmp_fi3d)
    14561533
    14571534#ifdef CPP_XIOS
    … …  
    14981575       CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d)
    14991576       CALL histwrite_phy(o_rhum, zx_rh)
    1500        CALL histwrite_phy(o_ozone, &
    1501             wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
     1577       
     1578       IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd
     1579       CALL histwrite_phy(o_ozone, zx_tmp_fi3d)
    15021580
    15031581       IF (read_climoz == 2) THEN
    1504           CALL histwrite_phy(o_ozone_light, &
    1505                wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
     1582         IF (vars_defined) zx_tmp_fi3d = wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd
     1583         CALL histwrite_phy(o_ozone_light, zx_tmp_fi3d)
    15061584       ENDIF
    15071585
    … …  
    15111589
    15121590       CALL histwrite_phy(o_dqphy,  d_qx(:,:,ivap))
    1513        CALL water_int(klon,klev,d_qx(:,:,ivap),zmasse,zx_tmp_fi2d)
     1591       IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,ivap),zmasse,zx_tmp_fi2d)
    15141592       CALL histwrite_phy(o_dqphy2d,  zx_tmp_fi2d)
    15151593
    15161594       CALL histwrite_phy(o_dqlphy,  d_qx(:,:,iliq))
    1517        CALL water_int(klon,klev,d_qx(:,:,iliq),zmasse,zx_tmp_fi2d)
     1595       IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,iliq),zmasse,zx_tmp_fi2d)
    15181596       CALL histwrite_phy(o_dqlphy2d,  zx_tmp_fi2d)
    15191597
    15201598       IF (nqo.EQ.3) THEN
    15211599       CALL histwrite_phy(o_dqsphy,  d_qx(:,:,isol))
    1522        CALL water_int(klon,klev,d_qx(:,:,isol),zmasse,zx_tmp_fi2d)
     1600       IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,isol),zmasse,zx_tmp_fi2d)
    15231601       CALL histwrite_phy(o_dqsphy2d,  zx_tmp_fi2d)
    15241602       ELSE
    … …  
    16051683       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    16061684       CALL histwrite_phy(o_dqcon, zx_tmp_fi3d)
    1607        CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1685       IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    16081686       CALL histwrite_phy(o_dqcon2d, zx_tmp_fi2d)
    16091687
    … …  
    16271705       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys
    16281706       CALL histwrite_phy(o_dqlsc, zx_tmp_fi3d)
    1629        CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1707       IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    16301708       CALL histwrite_phy(o_dqlsc2d, zx_tmp_fi2d)
    16311709       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=beta_prec(1:klon,1:klev)
    … …  
    16401718          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys
    16411719          CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d)
    1642           CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1720          IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    16431721          CALL histwrite_phy(o_dqlscth2d, zx_tmp_fi2d)
    16441722          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys
    16451723          CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d)
    1646           CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1724          IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    16471725          CALL histwrite_phy(o_dqlscst2d, zx_tmp_fi2d)
    16481726          CALL histwrite_phy(o_plulth, plul_th)
    … …  
    16981776       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys
    16991777       CALL histwrite_phy(o_dqvdf, zx_tmp_fi3d)
    1700        CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1778       IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    17011779       CALL histwrite_phy(o_dqvdf2d, zx_tmp_fi2d)
    17021780       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys
    … …  
    17041782       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_eva(1:klon,1:klev)/pdtphys
    17051783       CALL histwrite_phy(o_dqeva, zx_tmp_fi3d)
    1706        CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1784       IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    17071785       CALL histwrite_phy(o_dqeva2d, zx_tmp_fi2d)
    17081786       CALL histwrite_phy(o_ratqs, ratqs)
    … …  
    17431821          ENDIF
    17441822          CALL histwrite_phy(o_dqthe, zx_tmp_fi3d)
    1745           CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1823          IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    17461824          CALL histwrite_phy(o_dqthe2d, zx_tmp_fi2d)
    17471825       ENDIF !iflag_thermals
    … …  
    17501828       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
    17511829       CALL histwrite_phy(o_dqajs, zx_tmp_fi3d)
    1752        CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1830       IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    17531831       CALL histwrite_phy(o_dqajs2d, zx_tmp_fi2d)
    17541832       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys
    … …  
    17861864
    17871865       IF (ok_hines) THEN
    1788           CALL histwrite_phy(o_du_gwd_hines, du_gwd_hines/pdtphys)
    1789           CALL histwrite_phy(o_dv_gwd_hines, dv_gwd_hines/pdtphys)
     1866          IF (vars_defined) zx_tmp_fi3d=du_gwd_hines/pdtphys
     1867          CALL histwrite_phy(o_du_gwd_hines, zx_tmp_fi3d)
     1868
     1869          IF (vars_defined) zx_tmp_fi3d= dv_gwd_hines/pdtphys         
     1870          CALL histwrite_phy(o_dv_gwd_hines, zx_tmp_fi3d)
     1871         
    17901872          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys
    17911873          CALL histwrite_phy(o_dthin, zx_tmp_fi3d)
    … …  
    17951877
    17961878       IF (.not. ok_hines .and. ok_gwd_rando) THEN
    1797           CALL histwrite_phy(o_du_gwd_front, du_gwd_front / pdtphys)
    1798           CALL histwrite_phy(o_dv_gwd_front, dv_gwd_front / pdtphys)
     1879          IF (vars_defined)  zx_tmp_fi3d=du_gwd_front / pdtphys
     1880          CALL histwrite_phy(o_du_gwd_front, zx_tmp_fi3d)
     1881         
     1882          IF (vars_defined)  zx_tmp_fi3d=dv_gwd_front / pdtphys
     1883          CALL histwrite_phy(o_dv_gwd_front, zx_tmp_fi3d)
     1884         
    17991885          CALL histwrite_phy(o_ustr_gwd_front, zustr_gwd_front)
    18001886          CALL histwrite_phy(o_vstr_gwd_front, zvstr_gwd_front)
    … …  
    18021888
    18031889       IF (ok_gwd_rando) THEN
    1804           CALL histwrite_phy(o_du_gwd_rando, du_gwd_rando / pdtphys)
    1805           CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_rando / pdtphys)
     1890          IF (vars_defined)  zx_tmp_fi3d=du_gwd_rando / pdtphys
     1891          CALL histwrite_phy(o_du_gwd_rando, zx_tmp_fi3d)
     1892         
     1893          IF (vars_defined)  zx_tmp_fi3d=dv_gwd_rando / pdtphys
     1894          CALL histwrite_phy(o_dv_gwd_rando, zx_tmp_fi3d)
    18061895          CALL histwrite_phy(o_ustr_gwd_rando, zustr_gwd_rando)
    18071896          CALL histwrite_phy(o_vstr_gwd_rando, zvstr_gwd_rando)
    … …  
    18111900
    18121901       IF (ok_qch4) THEN
    1813           CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys)
    1814        ENDIF
    1815 
    1816        DO k=1, klevp1
    1817          zx_tmp_fi3d1(:,k)=swup(:,k)*swradcorr(:)
    1818        ENDDO
     1902          IF (vars_defined) zx_tmp_fi3d=d_q_ch4 / pdtphys
     1903          CALL histwrite_phy(o_dqch4, zx_tmp_fi3d)
     1904       ENDIF
     1905       
     1906       IF (vars_defined) THEN
     1907         DO k=1, klevp1
     1908           zx_tmp_fi3d1(:,k)=swup(:,k)*swradcorr(:)
     1909         ENDDO
     1910       ENDIF
     1911       
    18191912       CALL histwrite_phy(o_rsu, zx_tmp_fi3d1)
    1820        DO k=1, klevp1
    1821          zx_tmp_fi3d1(:,k)=swdn(:,k)*swradcorr(:)
    1822        ENDDO
     1913
     1914
     1915       IF (vars_defined) THEN
     1916         DO k=1, klevp1
     1917           zx_tmp_fi3d1(:,k)=swdn(:,k)*swradcorr(:)
     1918         ENDDO
     1919       ENDIF
     1920       
    18231921       CALL histwrite_phy(o_rsd, zx_tmp_fi3d1)
    1824        DO k=1, klevp1
    1825          zx_tmp_fi3d1(:,k)=swup0(:,k)*swradcorr(:)
    1826        ENDDO
     1922
     1923       IF (vars_defined) THEN
     1924         DO k=1, klevp1
     1925           zx_tmp_fi3d1(:,k)=swup0(:,k)*swradcorr(:)
     1926         ENDDO
     1927       ENDIF
     1928       
    18271929       CALL histwrite_phy(o_rsucs, zx_tmp_fi3d1)
    1828        DO k=1, klevp1
    1829          zx_tmp_fi3d1(:,k)=swupc0(:,k)*swradcorr(:)
    1830        ENDDO
     1930
     1931       IF (vars_defined) THEN
     1932         DO k=1, klevp1
     1933           zx_tmp_fi3d1(:,k)=swupc0(:,k)*swradcorr(:)
     1934         ENDDO
     1935       ENDIF
    18311936       CALL histwrite_phy(o_rsucsaf, zx_tmp_fi3d1)
    1832        DO k=1, klevp1
    1833          zx_tmp_fi3d1(:,k)=swdn0(:,k)*swradcorr(:)
    1834        ENDDO
     1937
     1938       IF (vars_defined) THEN
     1939         DO k=1, klevp1
     1940           zx_tmp_fi3d1(:,k)=swdn0(:,k)*swradcorr(:)
     1941         ENDDO
     1942       ENDIF
    18351943       CALL histwrite_phy(o_rsdcs, zx_tmp_fi3d1)
    1836        DO k=1, klevp1
    1837          zx_tmp_fi3d1(:,k)=swdnc0(:,k)*swradcorr(:)
    1838        ENDDO
     1944
     1945
     1946       IF (vars_defined) THEN
     1947         DO k=1, klevp1
     1948           zx_tmp_fi3d1(:,k)=swdnc0(:,k)*swradcorr(:)
     1949         ENDDO
     1950       ENDIF
    18391951       CALL histwrite_phy(o_rsdcsaf, zx_tmp_fi3d1)
    18401952
    … …  
    18902002       ELSE IF (iflag_con == 2) THEN
    18912003          CALL histwrite_phy(o_mcd,  pmfd)
    1892           CALL histwrite_phy(o_dmc,  pmfu + pmfd)
     2004          IF (vars_defined) zx_tmp_fi3d = pmfu + pmfd
     2005          CALL histwrite_phy(o_dmc,  zx_tmp_fi3d)
    18932006       ENDIF
    18942007       CALL histwrite_phy(o_ref_liq, ref_liq)
    … …  
    19042017          IF (vars_defined) zx_tmp_fi2d(:) = lwup0p(:,klevp1)
    19052018          CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d)
    1906           DO k=1, klevp1
    1907             zx_tmp_fi3d1(:,k)=swupp(:,k)*swradcorr(:)
    1908           ENDDO
     2019          IF (vars_defined) THEN
     2020            DO k=1, klevp1
     2021              zx_tmp_fi3d1(:,k)=swupp(:,k)*swradcorr(:)
     2022            ENDDO
     2023          ENDIF
    19092024          CALL histwrite_phy(o_rsu4co2, zx_tmp_fi3d1)
    1910           DO k=1, klevp1
    1911             zx_tmp_fi3d1(:,k)=swup0p(:,k)*swradcorr(:)
    1912           ENDDO
     2025          IF (vars_defined) THEN
     2026            DO k=1, klevp1
     2027              zx_tmp_fi3d1(:,k)=swup0p(:,k)*swradcorr(:)
     2028            ENDDO
     2029          ENDIF
    19132030          CALL histwrite_phy(o_rsucs4co2, zx_tmp_fi3d1)
    1914           DO k=1, klevp1
    1915             zx_tmp_fi3d1(:,k)=swdnp(:,k)*swradcorr(:)
    1916           ENDDO
     2031          IF (vars_defined) THEN
     2032            DO k=1, klevp1
     2033              zx_tmp_fi3d1(:,k)=swdnp(:,k)*swradcorr(:)
     2034            ENDDO
     2035          ENDIF
    19172036          CALL histwrite_phy(o_rsd4co2, zx_tmp_fi3d1)
    1918           DO k=1, klevp1
    1919             zx_tmp_fi3d1(:,k)=swdn0p(:,k)*swradcorr(:)
    1920           ENDDO
     2037          IF (vars_defined) THEN
     2038            DO k=1, klevp1
     2039              zx_tmp_fi3d1(:,k)=swdn0p(:,k)*swradcorr(:)
     2040            ENDDO
     2041          ENDIF
    19212042          CALL histwrite_phy(o_rsdcs4co2, zx_tmp_fi3d1)
    19222043          CALL histwrite_phy(o_rlu4co2, lwupp)
    … …  
    20712192            IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
    20722193             !--3D fields
    2073              CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    2074              CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    2075              CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    2076              CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
    2077              CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo))
    2078              CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo))
    2079              CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo))
    2080              CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo))
    2081              CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo))
    2082              CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo))
    2083              CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo))
    2084              CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo))
    2085              CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))
    2086              CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
     2194!             CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
     2195!             CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
     2196!             CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
     2197!             CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
     2198!             CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo))
     2199!             CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo))
     2200!             CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo))
     2201!             CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo))
     2202!             CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo))
     2203!             CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo))
     2204!             CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo))
     2205!             CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo))
     2206!             CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))
     2207!             CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
    20872208             !--2D fields
    2088              CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo))
     2209!             CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo))
    20892210             zx_tmp_fi2d=0.
    20902211             IF (vars_defined) THEN

  • LMDZ6/trunk/libf/phylmd/phys_state_var_mod.F90

    r3208 r3435  
    1818      INTEGER, SAVE :: radpas  ! radiation is called every "radpas" step
    1919      INTEGER, SAVE :: cvpas   ! convection is called every "cvpas" step
    20       INTEGER, SAVE :: cvpas_0 ! reference value for cvpas
     20      INTEGER, SAVE :: cvpas_0 = 1 ! reference value for cvpas
    2121      INTEGER, SAVE :: wkpas   ! wake scheme is called every "wkpas" step
    2222      REAL, PARAMETER :: missing_val_nf90=nf90_fill_real
    … …  
    2525!$OMP THREADPRIVATE(cvpas_0)
    2626!$OMP THREADPRIVATE(wkpas)
    27       REAL, SAVE :: dtime, solaire_etat0
    28 !$OMP THREADPRIVATE(dtime, solaire_etat0)
     27      REAL, SAVE :: phys_tstep=0, solaire_etat0
     28!$OMP THREADPRIVATE(phys_tstep, solaire_etat0)
    2929
    3030      REAL, ALLOCATABLE, SAVE :: pctsrf(:,:)
    … …  
    286286      REAL,ALLOCATABLE,SAVE :: total_rain(:), nday_rain(:) 
    287287!$OMP THREADPRIVATE(total_rain,nday_rain)
     288      REAL,ALLOCATABLE,SAVE :: paire_ter(:)
     289!$OMP THREADPRIVATE(paire_ter)
    288290! albsol1: albedo du sol total pour SW visible
    289291! albsol2: albedo du sol total pour SW proche IR
    … …  
    417419      ! tendencies on wind due to gravity waves
    418420
     421      LOGICAL,SAVE :: is_initialized=.FALSE.
     422!$OMP THREADPRIVATE(is_initialized)   
     423
    419424CONTAINS
    420425
    … …  
    437442include "clesphys.h"
    438443
     444      IF (is_initialized) RETURN
     445      is_initialized=.TRUE.
    439446      ALLOCATE(pctsrf(klon,nbsrf))
    440447      ALLOCATE(ftsol(klon,nbsrf))
    … …  
    452459      ALLOCATE(snow_fall(klon))
    453460      ALLOCATE(solsw(klon), sollw(klon))
     461      sollw=0.0
    454462      ALLOCATE(radsol(klon))
    455463      ALLOCATE(swradcorr(klon))
    … …  
    541549      ALLOCATE(wake_deltat(klon,klev), wake_deltaq(klon,klev))
    542550      ALLOCATE(wake_s(klon), awake_dens(klon), wake_dens(klon))
     551      awake_dens = 0.
    543552      ALLOCATE(wake_Cstar(klon))
    544553      ALLOCATE(wake_pe(klon), wake_fip(klon))
    … …  
    549558      ALLOCATE(pfrac_1nucl(klon,klev))
    550559      ALLOCATE(total_rain(klon), nday_rain(klon))
     560      ALLOCATE(paire_ter(klon))
    551561      ALLOCATE(albsol1(klon), albsol2(klon))
    552562!albedo SB >>>
    … …  
    566576      ALLOCATE(topsw(klon), toplw(klon))
    567577      ALLOCATE(sollwdown(klon), sollwdownclr(klon))
     578      sollwdown = 0.
    568579      ALLOCATE(toplwdown(klon), toplwdownclr(klon))
    569580      ALLOCATE(topsw0(klon),toplw0(klon),solsw0(klon),sollw0(klon))
     581      sollw0 = 0.
    570582      ALLOCATE(albpla(klon))
    571583!IM ajout variables CFMIP2/CMIP5
    … …  
    604616      ALLOCATE(ale_bl_trig(klon))
    605617!!! fin nrlmd le 10/04/2012
    606       if (ok_gwd_rando) allocate(du_gwd_rando(klon, klev))
    607       if (.not. ok_hines .and. ok_gwd_rando) allocate(du_gwd_front(klon, klev))
    608 
     618      IF (ok_gwd_rando) THEN
     619        allocate(du_gwd_rando(klon, klev))
     620        du_gwd_rando(:,:)=0.
     621      ENDIF
     622      IF (.not. ok_hines .and. ok_gwd_rando) THEN
     623        ALLOCATE(du_gwd_front(klon, klev))
     624        du_gwd_front(:,:) = 0 !ym missing init   
     625      ENDIF
    609626END SUBROUTINE phys_state_var_init
    610627
    … …  
    691708      deallocate(pfrac_1nucl)
    692709      deallocate(total_rain, nday_rain)
     710      deallocate(paire_ter)
    693711      deallocate(albsol1, albsol2)
    694712!albedo SB >>>
    … …  
    738756      deallocate(ale_bl_trig)
    739757!!! fin nrlmd le 10/04/2012
    740 
     758      is_initialized=.FALSE.
    741759END SUBROUTINE phys_state_var_end
    742760

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r3418 r3435  
    2525    USE dimphy
    2626    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac
    27     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo
     27    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
    2828    USE mod_phys_lmdz_para
    2929    USE iophy
    … …  
    265265    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
    266266    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps
     267    USE etat0_limit_unstruct_mod
     268#ifdef CPP_XIOS
     269    USE xios, ONLY: xios_update_calendar, xios_context_finalize
     270#endif
     271    USE limit_read_mod, ONLY : init_limit_read
     272    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
     273    USE readaerosol_mod, ONLY : init_aero_fromfile
     274    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
    267275
    268276    IMPLICIT NONE
    … …  
    11651173    !albedo SB >>>
    11661174    real,dimension(6),save :: SFRWL
     1175!$OMP THREADPRIVATE(SFRWL)
    11671176    !albedo SB <<<
    11681177
    … …  
    11831192    pdtphys=pdtphys_
    11841193    CALL update_time(pdtphys)
     1194    phys_tstep=NINT(pdtphys)
     1195#ifdef CPP_XIOS
     1196    IF (.NOT. debut .AND. is_omp_master) CALL xios_update_calendar(itap+1)
     1197#endif
    11851198
    11861199    !======================================================================
    … …  
    12151228
    12161229    IF (first) THEN
     1230       CALL init_etat0_limit_unstruct
     1231       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
    12171232       !CR:nvelles variables convection/poches froides
    12181233
    … …  
    12211236       CALL phys_local_var_init
    12221237       !
    1223        pasphys=pdtphys
    12241238       !     appel a la lecture du run.def physique
    12251239       CALL conf_phys(ok_journe, ok_mensuel, &
    … …  
    12391253       CALL phys_state_var_init(read_climoz)
    12401254       CALL phys_output_var_init
     1255       IF(read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
     1256
    12411257       print*, '================================================='
    12421258       !
    … …  
    13691385       ENDIF
    13701386
     1387       tau_aero(:,:,:,:) = 1.e-15
     1388       piz_aero(:,:,:,:) = 1.
     1389       cg_aero(:,:,:,:)  = 0.
     1390
    13711391       IF (aerosol_couple .AND. (config_inca /= "aero" &
    13721392            .AND. config_inca /= "aeNP ")) THEN
    … …  
    14171437       ! pour obtenir le meme resultat.
    14181438!jyg for fh<
    1419 !!       dtime=pdtphys
    1420        dtime=NINT(pdtphys)
    1421        WRITE(lunout,*) 'Pas de temps dtime pdtphys ',dtime,pdtphys
    1422        IF (abs(dtime-pdtphys)>1.e-10) THEN
     1439       WRITE(lunout,*) 'Pas de temps phys_tstep pdtphys ',phys_tstep,pdtphys
     1440       IF (abs(phys_tstep-pdtphys)>1.e-10) THEN
    14231441          abort_message='pas de temps doit etre entier en seconde pour orchidee et XIOS'
    14241442          CALL abort_physic(modname,abort_message,1)
    14251443       ENDIF
    14261444!>jyg
    1427        IF (MOD(NINT(86400./dtime),nbapp_rad).EQ.0) THEN
    1428           radpas = NINT( 86400./dtime)/nbapp_rad
     1445       IF (MOD(NINT(86400./phys_tstep),nbapp_rad).EQ.0) THEN
     1446          radpas = NINT( 86400./phys_tstep)/nbapp_rad
    14291447       ELSE
    14301448          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
    … …  
    14361454          CALL abort_physic(modname,abort_message,1)
    14371455       ENDIF
    1438        IF (nbapp_cv .EQ. 0) nbapp_cv=86400./dtime
    1439        IF (nbapp_wk .EQ. 0) nbapp_wk=86400./dtime
     1456       IF (nbapp_cv .EQ. 0) nbapp_cv=86400./phys_tstep
     1457       IF (nbapp_wk .EQ. 0) nbapp_wk=86400./phys_tstep
    14401458       print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk
    1441        IF (MOD(NINT(86400./dtime),nbapp_cv).EQ.0) THEN
    1442           cvpas_0 = NINT( 86400./dtime)/nbapp_cv
     1459       IF (MOD(NINT(86400./phys_tstep),nbapp_cv).EQ.0) THEN
     1460          cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv
    14431461          cvpas = cvpas_0
    14441462       print *,'physiq, cvpas ',cvpas
    … …  
    14521470          call abort_physic(modname,abort_message,1)
    14531471       ENDIF
    1454        IF (MOD(NINT(86400./dtime),nbapp_wk).EQ.0) THEN
    1455           wkpas = NINT( 86400./dtime)/nbapp_wk
     1472       IF (MOD(NINT(86400./phys_tstep),nbapp_wk).EQ.0) THEN
     1473          wkpas = NINT( 86400./phys_tstep)/nbapp_wk
    14561474       print *,'physiq, wkpas ',wkpas
    14571475       ELSE
    … …  
    14651483       ENDIF
    14661484       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1467 
     1485       CALL init_iophy_new(latitude_deg,longitude_deg)
     1486
     1487          !===================================================================
     1488          !IM stations CFMIP
     1489          nCFMIP=npCFMIP
     1490          OPEN(98,file='npCFMIP_param.data',status='old', &
     1491               form='formatted',iostat=iostat)
     1492          IF (iostat == 0) THEN
     1493             READ(98,*,end=998) nCFMIP
     1494998          CONTINUE
     1495             CLOSE(98)
     1496             CONTINUE
     1497             IF(nCFMIP.GT.npCFMIP) THEN
     1498                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
     1499                CALL abort_physic("physiq", "", 1)
     1500             ELSE
     1501                print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
     1502             ENDIF
     1503
     1504             !
     1505             ALLOCATE(tabCFMIP(nCFMIP))
     1506             ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
     1507             ALLOCATE(tabijGCM(nCFMIP))
     1508             ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
     1509             ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
     1510             !
     1511             ! lecture des nCFMIP stations CFMIP, de leur numero
     1512             ! et des coordonnees geographiques lonCFMIP, latCFMIP
     1513             !
     1514             CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP,  &
     1515                  lonCFMIP, latCFMIP)
     1516             !
     1517             ! identification des
     1518             ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
     1519             ! grille de LMDZ
     1520             ! 2) indices points tabijGCM de la grille physique 1d sur
     1521             ! klon points
     1522             ! 3) indices iGCM, jGCM de la grille physique 2d
     1523             !
     1524             CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
     1525                  tabijGCM, lonGCM, latGCM, iGCM, jGCM)
     1526             !
     1527          ELSE
     1528             ALLOCATE(tabijGCM(0))
     1529             ALLOCATE(lonGCM(0), latGCM(0))
     1530             ALLOCATE(iGCM(0), jGCM(0))
     1531          ENDIF
     1532
     1533#ifdef CPP_IOIPSL
     1534
     1535       !$OMP MASTER
     1536       ! FH : if ok_sync=.true. , the time axis is written at each time step
     1537       ! in the output files. Only at the end in the opposite case
     1538       ok_sync_omp=.false.
     1539       CALL getin('ok_sync',ok_sync_omp)
     1540       CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
     1541            iGCM,jGCM,lonGCM,latGCM, &
     1542            jjmp1,nlevSTD,clevSTD,rlevSTD, phys_tstep,ok_veget, &
     1543            type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
     1544            ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, &
     1545            read_climoz, phys_out_filestations, &
     1546            new_aod, aerosol_couple, &
     1547            flag_aerosol_strat, pdtphys, paprs, pphis,  &
     1548            pplay, lmax_th, ptconv, ptconvth, ivap,  &
     1549            d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
     1550       !$OMP END MASTER
     1551       !$OMP BARRIER
     1552       ok_sync=ok_sync_omp
     1553
     1554       freq_outNMC(1) = ecrit_files(7)
     1555       freq_outNMC(2) = ecrit_files(8)
     1556       freq_outNMC(3) = ecrit_files(9)
     1557       WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
     1558       WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
     1559       WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
     1560
     1561#ifndef CPP_XIOS
     1562       CALL ini_paramLMDZ_phy(phys_tstep,nid_ctesGCM)
     1563#endif
     1564
     1565#endif
     1566       ecrit_reg = ecrit_reg * un_jour
     1567       ecrit_tra = ecrit_tra * un_jour
     1568
     1569       !XXXPB Positionner date0 pour initialisation de ORCHIDEE
     1570       date0 = jD_ref
     1571       WRITE(*,*) 'physiq date0 : ',date0
     1572       !
     1573
     1574!       CALL create_climoz(read_climoz)
     1575       CALL init_aero_fromfile(flag_aerosol)  !! initialise aero from file for XIOS interpolation (unstructured_grid)
     1576       CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
     1577
     1578       IF(read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
     1579       CALL create_etat0_limit_unstruct
    14681580       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
     1581
    14691582!jyg<
    14701583       IF (klon_glo==1) THEN
    … …  
    14801593              pbl_tke(:,:,:) = 0.
    14811594          ENDIF  ! (iflag_pbl > 1)
     1595        ELSE
     1596          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
    14821597!>jyg
    14831598       ENDIF
     1599#ifdef CPP_COSP
     1600
     1601      IF (ok_cosp) THEN
     1602         CALL phys_cosp(itap,phys_tstep,freq_cosp, &
     1603               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
     1604               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
     1605               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
     1606               JrNt,ref_liq,ref_ice, &
     1607               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
     1608               zu10m,zv10m,pphis, &
     1609               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
     1610               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
     1611               prfl(:,1:klev),psfl(:,1:klev), &
     1612               pmflxr(:,1:klev),pmflxs(:,1:klev), &
     1613               mr_ozone,cldtau, cldemi)
     1614      ENDIF
     1615#endif
     1616
     1617       CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
     1618                              pplay, lmax_th, aerosol_couple,                 &
     1619                              ok_ade, ok_aie, ivap, iliq, isol, new_aod, ok_sync,&
     1620                              ptconv, read_climoz, clevSTD,                   &
     1621                              ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
     1622                              flag_aerosol, flag_aerosol_strat, ok_cdnc)
     1623
     1624#ifdef CPP_XIOS
     1625       IF (is_omp_master) CALL xios_update_calendar(1)
     1626#endif
     1627
    14841628       !IM begin
    14851629       print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
    … …  
    14961640       ENDIF
    14971641
    1498        CALL printflag( tabcntr0,radpas,ok_journe, &
    1499             ok_instan, ok_region )
    1500        !
    1501        IF (ABS(dtime-pdtphys).GT.0.001) THEN
    1502           WRITE(lunout,*) 'Pas physique n est pas correct',dtime, &
    1503                pdtphys
    1504           abort_message='Pas physique n est pas correct '
    1505           !           call abort_physic(modname,abort_message,1)
    1506           dtime=pdtphys
    1507        ENDIF
     1642!       IF (ABS(phys_tstep-pdtphys).GT.0.001) THEN
     1643!          WRITE(lunout,*) 'Pas physique n est pas correct',phys_tstep, &
     1644!               pdtphys
     1645!          abort_message='Pas physique n est pas correct '
     1646!          !           call abort_physic(modname,abort_message,1)
     1647!          phys_tstep=pdtphys
     1648!       ENDIF
    15081649       IF (nlon .NE. klon) THEN
    15091650          WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon,  &
    … …  
    15191660       ENDIF
    15201661       !
    1521        IF (dtime*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
     1662       IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
    15221663          WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
    15231664          WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
    … …  
    15811722          !        enddo
    15821723
    1583           !===================================================================
    1584           !IM stations CFMIP
    1585           nCFMIP=npCFMIP
    1586           OPEN(98,file='npCFMIP_param.data',status='old', &
    1587                form='formatted',iostat=iostat)
    1588           IF (iostat == 0) THEN
    1589              READ(98,*,end=998) nCFMIP
    1590 998          CONTINUE
    1591              CLOSE(98)
    1592              CONTINUE
    1593              IF(nCFMIP.GT.npCFMIP) THEN
    1594                 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
    1595                 CALL abort_physic("physiq", "", 1)
    1596              ELSE
    1597                 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
    1598              ENDIF
    1599 
    1600              !
    1601              ALLOCATE(tabCFMIP(nCFMIP))
    1602              ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
    1603              ALLOCATE(tabijGCM(nCFMIP))
    1604              ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
    1605              ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
    1606              !
    1607              ! lecture des nCFMIP stations CFMIP, de leur numero
    1608              ! et des coordonnees geographiques lonCFMIP, latCFMIP
    1609              !
    1610              CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP,  &
    1611                   lonCFMIP, latCFMIP)
    1612              !
    1613              ! identification des
    1614              ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
    1615              ! grille de LMDZ
    1616              ! 2) indices points tabijGCM de la grille physique 1d sur
    1617              ! klon points
    1618              ! 3) indices iGCM, jGCM de la grille physique 2d
    1619              !
    1620              CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
    1621                   tabijGCM, lonGCM, latGCM, iGCM, jGCM)
    1622              !
    1623           ELSE
    1624              ALLOCATE(tabijGCM(0))
    1625              ALLOCATE(lonGCM(0), latGCM(0))
    1626              ALLOCATE(iGCM(0), jGCM(0))
    1627           ENDIF
    1628        ELSE
    1629           ALLOCATE(tabijGCM(0))
    1630           ALLOCATE(lonGCM(0), latGCM(0))
    1631           ALLOCATE(iGCM(0), jGCM(0))
     1724       !ELSE
     1725       !   ALLOCATE(tabijGCM(0))
     1726       !   ALLOCATE(lonGCM(0), latGCM(0))
     1727       !   ALLOCATE(iGCM(0), jGCM(0))
    16321728       ENDIF
    16331729
    … …  
    16651761       !
    16661762       !
    1667        lmt_pas = NINT(86400./dtime * 1.0)   ! tous les jours
     1763       lmt_pas = NINT(86400./phys_tstep * 1.0)   ! tous les jours
    16681764       WRITE(lunout,*)'La frequence de lecture surface est de ',  &
    16691765            lmt_pas
    … …  
    16811777       !   Initialisation des sorties
    16821778       !=============================================================
     1779
     1780#ifdef CPP_XIOS
     1781       ! Get "missing_val" value from XML files (from temperature variable)
     1782       !$OMP MASTER
     1783       CALL xios_get_field_attr("temp",default_value=missing_val_omp)
     1784       !$OMP END MASTER
     1785       !$OMP BARRIER
     1786       missing_val=missing_val_omp
     1787#endif
    16831788
    16841789#ifdef CPP_XIOS
    … …  
    16931798#endif
    16941799
    1695 #ifdef CPP_IOIPSL
    1696 
    1697        !$OMP MASTER
    1698        ! FH : if ok_sync=.true. , the time axis is written at each time step
    1699        ! in the output files. Only at the end in the opposite case
    1700        ok_sync_omp=.false.
    1701        CALL getin('ok_sync',ok_sync_omp)
    1702        CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
    1703             iGCM,jGCM,lonGCM,latGCM, &
    1704             jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
    1705             type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
    1706             ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, &
    1707             read_climoz, phys_out_filestations, &
    1708             new_aod, aerosol_couple, &
    1709             flag_aerosol_strat, pdtphys, paprs, pphis,  &
    1710             pplay, lmax_th, ptconv, ptconvth, ivap,  &
    1711             d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
    1712        !$OMP END MASTER
    1713        !$OMP BARRIER
    1714        ok_sync=ok_sync_omp
    1715 
    1716        freq_outNMC(1) = ecrit_files(7)
    1717        freq_outNMC(2) = ecrit_files(8)
    1718        freq_outNMC(3) = ecrit_files(9)
    1719        WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
    1720        WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
    1721        WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
    1722 
    1723 #ifndef CPP_XIOS
    1724        CALL ini_paramLMDZ_phy(dtime,nid_ctesGCM)
    1725 #endif
    1726 
    1727 #endif
    1728        ecrit_reg = ecrit_reg * un_jour
    1729        ecrit_tra = ecrit_tra * un_jour
    1730 
    1731        !XXXPB Positionner date0 pour initialisation de ORCHIDEE
    1732        date0 = jD_ref
    1733        WRITE(*,*) 'physiq date0 : ',date0
     1800
     1801       CALL printflag( tabcntr0,radpas,ok_journe, &
     1802            ok_instan, ok_region )
    17341803       !
    17351804       !
    … …  
    18911960    ! on the surface fraction.
    18921961    !
    1893     CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
     1962    CALL change_srf_frac(itap, phys_tstep, days_elapsed+1,  &
    18941963         pctsrf, fevap, z0m, z0h, agesno,              &
    18951964         falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
    … …  
    20212090    IF (ancien_ok) THEN
    20222091    !
    2023        d_u_dyn(:,:)  = (u_seri(:,:)-u_ancien(:,:))/dtime
    2024        d_v_dyn(:,:)  = (v_seri(:,:)-v_ancien(:,:))/dtime
    2025        d_t_dyn(:,:)  = (t_seri(:,:)-t_ancien(:,:))/dtime
    2026        d_q_dyn(:,:)  = (q_seri(:,:)-q_ancien(:,:))/dtime
    2027        d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/dtime
    2028        d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/dtime
     2092       d_u_dyn(:,:)  = (u_seri(:,:)-u_ancien(:,:))/phys_tstep
     2093       d_v_dyn(:,:)  = (v_seri(:,:)-v_ancien(:,:))/phys_tstep
     2094       d_t_dyn(:,:)  = (t_seri(:,:)-t_ancien(:,:))/phys_tstep
     2095       d_q_dyn(:,:)  = (q_seri(:,:)-q_ancien(:,:))/phys_tstep
     2096       d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
     2097       d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
    20292098       CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
    2030        d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/dtime
     2099       d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
    20312100       CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d)
    2032        d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/dtime
     2101       d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/phys_tstep
    20332102       CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d)
    2034        d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/dtime
     2103       d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
    20352104       ! !! RomP >>>   td dyn traceur
    20362105       IF (nqtot.GT.nqo) THEN     ! jyg
    20372106          DO iq = nqo+1, nqtot      ! jyg
    2038               d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/dtime ! jyg
     2107              d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/phys_tstep ! jyg
    20392108          ENDDO
    20402109       ENDIF
    … …  
    22132282          !  bit comparable a l ancienne formulation cycle_diurne=true
    22142283          !  on integre entre gmtime et gmtime+radpas
    2215           zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
     2284          zdtime=phys_tstep*REAL(radpas) ! pas de temps du rayonnement (s)
    22162285          CALL zenang(zlongi,jH_cur,0.0,zdtime, &
    22172286               latitude_deg,longitude_deg,rmu0,fract)
    … …  
    22302299          !  premier pas de temps de la physique pendant lequel
    22312300          !  itaprad=0
    2232           zdtime1=dtime*REAL(-MOD(itaprad,radpas)-1)     
    2233           zdtime2=dtime*REAL(radpas-MOD(itaprad,radpas)-1)
     2301          zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1)     
     2302          zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1)
    22342303          CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
    22352304               latitude_deg,longitude_deg,rmu0,fract)
    … …  
    22372306          ! Calcul des poids
    22382307          !
    2239           zdtime1=-dtime !--on corrige le rayonnement pour representer le
     2308          zdtime1=-phys_tstep !--on corrige le rayonnement pour representer le
    22402309          zdtime2=0.0    !--pas de temps de la physique qui se termine
    22412310          CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
    … …  
    22952364       !
    22962365       !-------gustiness calculation-------!
     2366       !ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3
     2367       gustiness=0  !ym missing init
     2368       
    22972369       IF (iflag_gusts==0) THEN
    22982370          gustiness(1:klon)=0
    … …  
    23152387
    23162388       CALL pbl_surface(  &
    2317             dtime,     date0,     itap,    days_elapsed+1, &
     2389            phys_tstep,     date0,     itap,    days_elapsed+1, &
    23182390            debut,     lafin, &
    23192391            longitude_deg, latitude_deg, rugoro,  zrmu0,      &
    … …  
    24822554       DO i = 1, klon
    24832555          conv_q(i,k) = d_q_dyn(i,k)  &
    2484                + d_q_vdf(i,k)/dtime
     2556               + d_q_vdf(i,k)/phys_tstep
    24852557          conv_t(i,k) = d_t_dyn(i,k)  &
    2486                + d_t_vdf(i,k)/dtime
     2558               + d_t_vdf(i,k)/phys_tstep
    24872559       ENDDO
    24882560    ENDDO
    … …  
    25492621       abort_message ='reactiver le call conlmd dans physiq.F'
    25502622       CALL abort_physic (modname,abort_message,1)
    2551        !     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
     2623       !     CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q,
    25522624       !    .             d_t_con, d_q_con,
    25532625       !    .             rain_con, snow_con, ibas_con, itop_con)
    25542626    ELSE IF (iflag_con.EQ.2) THEN
    2555        CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &
     2627       CALL conflx(phys_tstep, paprs, pplay, t_seri, q_seri, &
    25562628            conv_t, conv_q, -evap, omega, &
    25572629            d_t_con, d_q_con, rain_con, snow_con, &
    … …  
    26292701
    26302702!jyg<
    2631        CALL alpale( debut, itap, dtime, paprs, omega, t_seri,   &
     2703       CALL alpale( debut, itap, phys_tstep, paprs, omega, t_seri,   &
    26322704                    alp_offset, it_wape_prescr,  wape_prescr, fip_prescr, &
    26332705                    ale_bl_prescr, alp_bl_prescr, &
    … …  
    26712743          !c          CALL concvl (iflag_con,iflag_clos,
    26722744          CALL concvl (iflag_clos, &
    2673                dtime, paprs, pplay, k_upper_cv, t_x,q_x, &
     2745               phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, &
    26742746               t_w,q_w,wake_s, &
    26752747               u_seri,v_seri,tr_seri,nbtr_tmp, &
    … …  
    27412813              DO k=1,klev
    27422814                 DO i=1,klon
    2743                     ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/dtime
    2744                     fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/dtime
     2815                    ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep
     2816                    fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep
    27452817                    d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
    27462818                    d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
    … …  
    27542826
    27552827          ! MAF conema3 ne contient pas les traceurs
    2756           CALL conema3 (dtime, &
     2828          CALL conema3 (phys_tstep, &
    27572829               paprs,pplay,t_seri,q_seri, &
    27582830               u_seri,v_seri,tr_seri,ntra, &
    … …  
    28862958               snow_con(i))*cell_area(i)/REAL(klon)
    28872959       ENDDO
    2888        zx_t = zx_t/za*dtime
     2960       zx_t = zx_t/za*phys_tstep
    28892961       WRITE(lunout,*)"Precip=", zx_t
    28902962    ENDIF
    … …  
    29002972       ENDDO
    29012973       DO i = 1, klon
    2902           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &
     2974          z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
    29032975               /z_apres(i)
    29042976       ENDDO
    … …  
    29373009                M_dwn(i,k)   = dnwd0(i,k)
    29383010                M_up(i,k)    = upwd(i,k)
    2939                 dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k)
    2940                 dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
     3011                dt_a(i,k)    = d_t_con(i,k)/phys_tstep - ftd(i,k)
     3012                dq_a(i,k)    = d_q_con(i,k)/phys_tstep - fqd(i,k)
    29413013             ENDDO
    29423014          ENDDO
    … …  
    29463018             DO k = 1,klev
    29473019                dt_dwn(:,k)= dt_dwn(:,k)+ &
    2948                      ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime
     3020                     ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep
    29493021                dq_dwn(:,k)= dq_dwn(:,k)+ &
    2950                      ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime
     3022                     ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep
    29513023             ENDDO
    29523024          ELSEIF (iflag_wake==3) THEN
    … …  
    29593031                      ! l'eau se reevapore).
    29603032                      dt_dwn(i,k)= dt_dwn(i,k)+ &
    2961                            ok_wk_lsp(i)*d_t_lsc(i,k)/dtime
     3033                           ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep
    29623034                      dq_dwn(i,k)= dq_dwn(i,k)+ &
    2963                            ok_wk_lsp(i)*d_q_lsc(i,k)/dtime
     3035                           ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep
    29643036                   ENDIF
    29653037                ENDDO
    … …  
    29693041          !
    29703042          !calcul caracteristiques de la poche froide
    2971           CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
     3043          CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, &
    29723044               t_seri, q_seri, omega,  &
    29733045               dt_dwn, dq_dwn, M_dwn, M_up,  &
    … …  
    30163088       IF (iflag_alp_wk_cond .GT. 0.) THEN
    30173089
    3018          CALL alpale_wk(dtime, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &
     3090         CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &
    30193091                        wake_fip)
    30203092       ELSE
    … …  
    31563228          !
    31573229!
    3158           CALL alpale_th( dtime, lmax_th, t_seri, cell_area,  &
     3230          CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area,  &
    31593231                          cin, s2, n2,  &
    31603232                          ale_bl_trig, ale_bl_stat, ale_bl,  &
    … …  
    32463318    ENDIF
    32473319    !
    3248     CALL fisrtilp(dtime,paprs,pplay, &
     3320    CALL fisrtilp(phys_tstep,paprs,pplay, &
    32493321         t_seri, q_seri,ptconv,ratqs, &
    32503322         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
    … …  
    33063378               + snow_lsc(i))*cell_area(i)/REAL(klon)
    33073379       ENDDO
    3308        zx_t = zx_t/za*dtime
     3380       zx_t = zx_t/za*phys_tstep
    33093381       WRITE(lunout,*)"Precip=", zx_t
    33103382    ENDIF
    … …  
    35263598       calday = REAL(days_elapsed + 1) + jH_cur
    35273599
    3528        CALL chemtime(itap+itau_phy-1, date0, dtime, itap)
     3600       CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
    35293601       IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN
    35303602          CALL AEROSOL_METEO_CALC( &
    … …  
    40724144
    40734145    DO k=1, klev
    4074        d_t_swr(:,k)=swradcorr(:)*heat(:,k)*dtime/RDAY
    4075        d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*dtime/RDAY
    4076        d_t_lwr(:,k)=-cool(:,k)*dtime/RDAY
    4077        d_t_lw0(:,k)=-cool0(:,k)*dtime/RDAY
     4146       d_t_swr(:,k)=swradcorr(:)*heat(:,k)*phys_tstep/RDAY
     4147       d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*phys_tstep/RDAY
     4148       d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY
     4149       d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY
    40784150    ENDDO
    40794151
    … …  
    41314203       IF (ok_strato) THEN
    41324204
    4133           CALL drag_noro_strato(0,klon,klev,dtime,paprs,pplay, &
     4205          CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, &
    41344206               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
    41354207               igwd,idx,itest, &
    … …  
    41394211
    41404212       ELSE
    4141           CALL drag_noro(klon,klev,dtime,paprs,pplay, &
     4213          CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, &
    41424214               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
    41434215               igwd,idx,itest, &
    … …  
    41804252       IF (ok_strato) THEN
    41814253
    4182           CALL lift_noro_strato(klon,klev,dtime,paprs,pplay, &
     4254          CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, &
    41834255               latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
    41844256               igwd,idx,itest, &
    … …  
    41884260
    41894261       ELSE
    4190           CALL lift_noro(klon,klev,dtime,paprs,pplay, &
     4262          CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, &
    41914263               latitude_deg,zmea,zstd,zpic, &
    41924264               itest, &
    … …  
    42084280       du_gwd_hines=0.
    42094281       dv_gwd_hines=0.
    4210        CALL hines_gwd(klon, klev, dtime, paprs, pplay, latitude_deg, t_seri, &
     4282       CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, &
    42114283            u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
    42124284            du_gwd_hines, dv_gwd_hines)
    … …  
    42144286       zvstr_gwd_hines=0.
    42154287       DO k = 1, klev
    4216           zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/dtime &
     4288          zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep &
    42174289               * (paprs(:, k)-paprs(:, k+1))/rg
    4218           zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/dtime &
     4290          zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep &
    42194291               * (paprs(:, k)-paprs(:, k+1))/rg
    42204292       ENDDO
    … …  
    42274299
    42284300    IF (.not. ok_hines .and. ok_gwd_rando) then
    4229        CALL acama_GWD_rando(DTIME, pplay, latitude_deg, t_seri, u_seri, &
     4301       ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
     4302       CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
    42304303            v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
    42314304            dv_gwd_front, east_gwstress, west_gwstress)
    … …  
    42334306       zvstr_gwd_front=0.
    42344307       DO k = 1, klev
    4235           zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/dtime &
     4308          zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep &
    42364309               * (paprs(:, k)-paprs(:, k+1))/rg
    4237           zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/dtime &
     4310          zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep &
    42384311               * (paprs(:, k)-paprs(:, k+1))/rg
    42394312       ENDDO
    … …  
    42454318
    42464319    IF (ok_gwd_rando) THEN
    4247        CALL FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
     4320       CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, &
    42484321            rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
    42494322            du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
    … …  
    42544327       zvstr_gwd_rando=0.
    42554328       DO k = 1, klev
    4256           zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/dtime &
     4329          zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep &
    42574330               * (paprs(:, k)-paprs(:, k+1))/rg
    4258           zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/dtime &
     4331          zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep &
    42594332               * (paprs(:, k)-paprs(:, k+1))/rg
    42604333       ENDDO
    … …  
    42764349    DO k = 1, klev
    42774350       DO i = 1, klon
    4278           zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* &
     4351          zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* &
    42794352               (paprs(i,k)-paprs(i,k+1))/rg
    4280           zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* &
     4353          zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* &
    42814354               (paprs(i,k)-paprs(i,k+1))/rg
    42824355       ENDDO
    … …  
    42994372       CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
    43004373       ! ajout de la tendance d'humidite due au methane
    4301        d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*dtime
     4374       d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
    43024375       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, &
    43034376            'q_ch4', abortphy,flag_inhib_tend,itap,0)
    4304        d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/dtime
     4377       d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep
    43054378    ENDIF
    43064379    !
    … …  
    43904463
    43914464
    4392        CALL drag_noro_strato(addtkeoro,klon,klev,dtime,paprs,pplay, &
     4465       CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, &
    43934466               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
    43944467               igwd,idx,itest, &
    … …  
    44314504       ! adeclarer
    44324505#ifdef CPP_COSP
    4433        IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
     4506       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
    44344507
    44354508          IF (prt_level .GE.10) THEN
    … …  
    44394512          !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
    44404513          !     s        ref_liq,ref_ice
    4441           CALL phys_cosp(itap,dtime,freq_cosp, &
     4514          CALL phys_cosp(itap,phys_tstep,freq_cosp, &
    44424515               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    44434516               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    … …  
    44624535
    44634536#ifdef CPP_COSP2
    4464        IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
     4537       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
    44654538
    44664539          IF (prt_level .GE.10) THEN
    … …  
    44704543                 print*,'Dans physiq.F avant appel '
    44714544          !     s        ref_liq,ref_ice
    4472           CALL phys_cosp2(itap,dtime,freq_cosp, &
     4545          CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
    44734546               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    44744547               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    … …  
    44924565  IF (ok_airs) then
    44934566
    4494   IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/dtime)).EQ.0) THEN
     4567  IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN
    44954568     write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
    44964569     CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
    … …  
    45474620    CALL phytrac ( &
    45484621         itap,     days_elapsed+1,    jH_cur,   debut, &
    4549          lafin,    dtime,     u, v,     t, &
     4622         lafin,    phys_tstep,     u, v,     t, &
    45504623         paprs,    pplay,     pmfu,     pmfd, &
    45514624         pen_u,    pde_u,     pen_d,    pde_d, &
    … …  
    45824655            cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
    45834656            frac_impa, frac_nucl, &
    4584             pphis,cell_area,dtime,itap, &
     4657            pphis,cell_area,phys_tstep,itap, &
    45854658            qx(:,:,ivap),da,phi,mp,upwd,dnwd)
    45864659
    … …  
    46534726
    46544727       CALL chemhook_end ( &
    4655             dtime, &
     4728            phys_tstep, &
    46564729            pplay, &
    46574730            t_seri, &
    … …  
    46884761    DO k = 1, klev
    46894762       DO i = 1, klon
    4690           d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
    4691           d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
    4692           d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
    4693           d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
    4694           d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
     4763          d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep
     4764          d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep
     4765          d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep
     4766          d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep
     4767          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
    46954768          !CR: on ajoute le contenu en glace
    46964769          IF (nqo.eq.3) THEN
    4697              d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime
     4770             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
    46984771          ENDIF
    46994772       ENDDO
    … …  
    47074780          DO  k = 1, klev
    47084781             DO  i = 1, klon
    4709                 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
    4710                 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / dtime
     4782                ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep
     4783                d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep
    47114784             ENDDO
    47124785          ENDDO
    … …  
    49625035       !         write(97) u_seri,v_seri,t_seri,q_seri
    49635036       !         close(97)
    4964        !$OMP MASTER
    4965        IF (read_climoz >= 1) THEN
    4966           IF (is_mpi_root) THEN
    4967              CALL nf95_close(ncid_climoz)
    4968           ENDIF
    4969           DEALLOCATE(press_edg_climoz) ! pointer
    4970           DEALLOCATE(press_cen_climoz) ! pointer
    4971        ENDIF
    4972        !$OMP END MASTER
     5037     
     5038       IF (is_omp_master) THEN
     5039       
     5040         IF (read_climoz >= 1) THEN
     5041           IF (is_mpi_root) CALL nf95_close(ncid_climoz)
     5042            DEALLOCATE(press_edg_climoz) ! pointer
     5043            DEALLOCATE(press_cen_climoz) ! pointer
     5044         ENDIF
     5045       
     5046       ENDIF
     5047#ifdef CPP_XIOS
     5048       IF (is_omp_master) CALL xios_context_finalize
     5049#endif
    49735050       print *,' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
    49745051    ENDIF

  • LMDZ6/trunk/libf/phylmd/radlwsw_m.F90

    r3412 r3435  
    398398  cgaero(:,:,:,:)=0.
    399399  lldebug=.FALSE.
     400
     401  ztopsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
     402  ztopsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
     403  zsolsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
     404  zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
    400405 
    401406  !

  • LMDZ6/trunk/libf/phylmd/readaerosol.F90

    r2841 r3435  
    44
    55  REAL, SAVE :: not_valid=-333.
     6 
     7  INTEGER, SAVE :: nbp_lon_src
     8!$OMP THREADPRIVATE(nbp_lon_src) 
     9  INTEGER, SAVE :: nbp_lat_src
     10!$OMP THREADPRIVATE(nbp_lat_src) 
     11  REAL, ALLOCATABLE, SAVE    :: psurf_interp(:,:)
     12!$OMP THREADPRIVATE(psurf_interp) 
    613
    714CONTAINS
    … …  
    167174
    168175
     176  SUBROUTINE init_aero_fromfile(flag_aerosol)
     177  USE netcdf
     178  USE mod_phys_lmdz_para
     179  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
     180  USE xios
     181  IMPLICIT NONE
     182  INTEGER, INTENT(IN) :: flag_aerosol
     183  REAL,ALLOCATABLE :: lat_src(:)
     184  REAL,ALLOCATABLE :: lon_src(:)
     185  CHARACTER(LEN=*),PARAMETER :: file_aerosol='aerosols.nat.nc'
     186  CHARACTER(LEN=*),PARAMETER :: file_so4='so4.nat.nc'
     187  INTEGER :: klev_src
     188  INTEGER :: ierr ,ncid, dimID, varid
     189  REAL :: null_array(0)
     190
     191  IF (flag_aerosol>0 .AND. grid_type==unstructured) THEN
     192 
     193    IF (is_omp_root) THEN
     194 
     195      IF (is_mpi_root) THEN
     196   
     197        IF (nf90_open(TRIM(file_aerosol), NF90_NOWRITE, ncid) /= NF90_NOERR) THEN
     198          CALL check_err( nf90_open(TRIM(file_so4), NF90_NOWRITE, ncid), "pb open "//trim(file_so4) )
     199        ENDIF
     200
     201        ! Read and test longitudes
     202        CALL check_err( nf90_inq_dimid(ncid, "lon", dimID),"pb inq dim lon")
     203        CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lon_src),"pb inq dim lon")
     204        CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
     205        ALLOCATE(lon_src(nbp_lon_src))
     206        CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
     207
     208        ! Read and test latitudes
     209        CALL check_err( nf90_inq_dimid(ncid, "lat", dimID),"pb inq dim lat")
     210        CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lat_src),"pb inq dim lat")
     211        CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
     212        ALLOCATE(lat_src(nbp_lat_src))
     213        CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
     214        IF (nf90_inq_dimid(ncid, 'lev', dimid) /= NF90_NOERR) THEN
     215          IF (nf90_inq_dimid(ncid, 'presnivs', dimid)/= NF90_NOERR) THEN
     216             CALL check_err(nf90_inq_dimid(ncid, 'PRESNIVS', dimid),'dimension lev,PRESNIVS or presnivs not in file')
     217          ENDIF
     218        ENDIF
     219        CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" )
     220        CALL check_err( nf90_close(ncid),"pb in close" )   
     221      ENDIF
     222
     223      CALL bcast_mpi(nbp_lat_src)
     224      CALL bcast_mpi(nbp_lon_src)
     225      CALL bcast_mpi(klev_src)
     226
     227      IF (is_mpi_root ) THEN
     228        CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=nbp_lat_src, jbegin=0, latvalue_1d=lat_src)
     229        CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=nbp_lon_src, ibegin=0, lonvalue_1d=lon_src)
     230      ELSE
     231        CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=0, jbegin=0, latvalue_1d=null_array )
     232        CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=0, ibegin=0, lonvalue_1d=null_array)
     233      ENDIF
     234      CALL xios_set_axis_attr("axis_aerosol",n_glo=klev_src)
     235      CALL xios_set_fieldgroup_attr("aerosols", enabled=.TRUE.)
     236 
     237    ENDIF
     238   
     239  ENDIF   
     240 
     241  END SUBROUTINE init_aero_fromfile
     242
     243
     244   
     245
    169246  SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, pt_year, psurf_out, load_out)
    170247!****************************************************************************************
    … …  
    187264    USE netcdf
    188265    USE dimphy
    189     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, &
    190                                  grid2Dto1D_glo
     266    USE mod_grid_phy_lmdz, ONLY: nbp_lon_=>nbp_lon, nbp_lat_=>nbp_lat, klon_glo, &
     267                                 grid2Dto1D_glo, grid_type, unstructured
    191268    USE mod_phys_lmdz_para
    192269    USE iophy, ONLY : io_lon, io_lat
    193270    USE print_control_mod, ONLY: lunout
     271    USE xios
    194272
    195273    IMPLICIT NONE
    … …  
    205283    REAL, POINTER, DIMENSION(:)           :: pt_b         ! Pointer for describing the vertical levels     
    206284    REAL, POINTER, DIMENSION(:,:,:)       :: pt_year      ! Pointer-variabale from file, 12 month, grid : klon,klev_src
     285    REAL, POINTER, DIMENSION(:,:,:)       :: pt_year_mpi  ! Pointer-variabale from file, 12 month, grid : klon,klev_src
    207286    REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf_out    ! Surface pression for 12 months
     287    REAL, DIMENSION(klon_mpi,12)          :: psurf_out_mpi    ! Surface pression for 12 months
    208288    REAL, DIMENSION(klon,12), INTENT(OUT) :: load_out     ! Aerosol mass load in each column
     289    REAL, DIMENSION(klon_mpi,12)          :: load_out_mpi     ! Aerosol mass load in each column
    209290    INTEGER                               :: nbr_tsteps   ! number of month in file read
    210291
    … …  
    220301    REAL, ALLOCATABLE, DIMENSION(:)       :: varktmp
    221302
    222     REAL, DIMENSION(nbp_lon,nbp_lat,12)   :: psurf_glo2D   ! Surface pression for 12 months on dynamics global grid
     303    REAL,  ALLOCATABLE                    :: psurf_glo2D(:,:,:)   ! Surface pression for 12 months on dynamics global grid
    223304    REAL, DIMENSION(klon_glo,12)          :: psurf_glo1D   ! -"- on physical global grid
    224     REAL, DIMENSION(nbp_lon,nbp_lat,12)   :: load_glo2D    ! Load for 12 months on dynamics global grid
     305    REAL,  ALLOCATABLE                    :: load_glo2D(:,:,:)    ! Load for 12 months on dynamics global grid
    225306    REAL, DIMENSION(klon_glo,12)          :: load_glo1D    ! -"- on physical global grid
    226     REAL, DIMENSION(nbp_lon,nbp_lat)      :: vartmp
    227     REAL, DIMENSION(nbp_lon)              :: lon_src              ! longitudes in file
    228     REAL, DIMENSION(nbp_lat)              :: lat_src, lat_src_inv ! latitudes in file
     307    REAL, ALLOCATABLE, DIMENSION(:,:)     :: vartmp
     308    REAL, ALLOCATABLE,DIMENSION(:)        :: lon_src              ! longitudes in file
     309    REAL, ALLOCATABLE,DIMENSION(:)        :: lat_src, lat_src_inv ! latitudes in file
    229310    LOGICAL                               :: new_file             ! true if new file format detected
    230311    LOGICAL                               :: invert_lat           ! true if the field has to be inverted for latitudes
    231 
    232 
     312    INTEGER                               :: nbp_lon, nbp_lat
     313    LOGICAL,SAVE                          :: first=.TRUE.
     314!$OMP THREADPRIVATE(first)
     315   
     316    IF (grid_type==unstructured) THEN
     317      nbp_lon=nbp_lon_src
     318      nbp_lat=nbp_lat_src
     319    ELSE
     320      nbp_lon=nbp_lon_
     321      nbp_lat=nbp_lat_
     322    ENDIF
     323   
     324    IF (is_mpi_root) THEN
     325   
     326      ALLOCATE(psurf_glo2D(nbp_lon,nbp_lat,12))
     327      ALLOCATE(load_glo2D(nbp_lon,nbp_lat,12))
     328      ALLOCATE(vartmp(nbp_lon,nbp_lat))
     329      ALLOCATE(lon_src(nbp_lon))
     330      ALLOCATE(lat_src(nbp_lat))
     331      ALLOCATE(lat_src_inv(nbp_lat))
     332    ELSE
     333      ALLOCATE(varyear(0,0,0,0))
     334      ALLOCATE(psurf_glo2D(0,0,0))
     335      ALLOCATE(load_glo2D(0,0,0))
     336    ENDIF
     337           
    233338    ! Deallocate pointers
    234339    IF (ASSOCIATED(pt_ap)) DEALLOCATE(pt_ap)
    … …  
    245350       CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid), "pb open "//trim(fname) )
    246351
     352
     353       IF (grid_type/=unstructured) THEN
     354
    247355! Test for equal longitudes and latitudes in file and model
    248356!****************************************************************************************
    249357       ! Read and test longitudes
    250        CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
    251        CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
     358         CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )
     359         CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )
    252360       
    253        IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN
    254           WRITE(lunout,*) 'Problem in longitudes read from file : ',TRIM(fname)
    255           WRITE(lunout,*) 'longitudes in file ', TRIM(fname),' : ', lon_src
    256           WRITE(lunout,*) 'longitudes in model :', io_lon
     361         IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN
     362            WRITE(lunout,*) 'Problem in longitudes read from file : ',TRIM(fname)
     363            WRITE(lunout,*) 'longitudes in file ', TRIM(fname),' : ', lon_src
     364            WRITE(lunout,*) 'longitudes in model :', io_lon
    257365         
    258           CALL abort_physic('get_aero_fromfile', 'longitudes are not the same in file and model',1)
    259        END IF
    260 
    261        ! Read and test latitudes
    262        CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
    263        CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
    264 
    265        ! Invert source latitudes
    266        DO j = 1, nbp_lat
    267           lat_src_inv(j) = lat_src(nbp_lat +1 -j)
    268        END DO
    269 
    270        IF (maxval(ABS(lat_src - io_lat)) < 0.001) THEN
    271           ! Latitudes are the same
    272           invert_lat=.FALSE.
    273        ELSE IF (maxval(ABS(lat_src_inv - io_lat)) < 0.001) THEN
    274           ! Inverted source latitudes correspond to model latitudes
    275           WRITE(lunout,*) 'latitudes will be inverted for file : ',TRIM(fname)
    276           invert_lat=.TRUE.
    277        ELSE
    278           WRITE(lunout,*) 'Problem in latitudes read from file : ',TRIM(fname)
    279           WRITE(lunout,*) 'latitudes in file ', TRIM(fname),' : ', lat_src     
    280           WRITE(lunout,*) 'latitudes in model :', io_lat
    281           CALL abort_physic('get_aero_fromfile', 'latitudes do not correspond between file and model',1)
    282        END IF
    283 
     366            CALL abort_physic('get_aero_fromfile', 'longitudes are not the same in file and model',1)
     367         END IF
     368
     369         ! Read and test latitudes
     370         CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )
     371         CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )
     372
     373         ! Invert source latitudes
     374         DO j = 1, nbp_lat
     375            lat_src_inv(j) = lat_src(nbp_lat +1 -j)
     376         END DO
     377
     378         IF (maxval(ABS(lat_src - io_lat)) < 0.001) THEN
     379            ! Latitudes are the same
     380            invert_lat=.FALSE.
     381         ELSE IF (maxval(ABS(lat_src_inv - io_lat)) < 0.001) THEN
     382            ! Inverted source latitudes correspond to model latitudes
     383            WRITE(lunout,*) 'latitudes will be inverted for file : ',TRIM(fname)
     384            invert_lat=.TRUE.
     385         ELSE
     386            WRITE(lunout,*) 'Problem in latitudes read from file : ',TRIM(fname)
     387            WRITE(lunout,*) 'latitudes in file ', TRIM(fname),' : ', lat_src     
     388            WRITE(lunout,*) 'latitudes in model :', io_lat
     389            CALL abort_physic('get_aero_fromfile', 'latitudes do not correspond between file and model',1)
     390         END IF
     391       ENDIF
    284392
    285393! 2) Check if old or new file is avalabale.
    … …  
    487595       END IF
    488596
    489 !     - Invert latitudes if necessary
    490        DO imth=1, 12
    491           IF (invert_lat) THEN
    492 
    493              ! Invert latitudes for the variable
    494              varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly
    495              DO k=1,klev_src
    496                 DO j=1,nbp_lat
    497                    DO i=1,nbp_lon
    498                       varyear(i,j,k,imth) = varmth(i,nbp_lat+1-j,k)
    499                    END DO
    500                 END DO
    501              END DO
     597
     598       IF (grid_type/=unstructured) THEN
     599  !     - Invert latitudes if necessary
     600         DO imth=1, 12
     601            IF (invert_lat) THEN
     602
     603               ! Invert latitudes for the variable
     604               varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly
     605               DO k=1,klev_src
     606                  DO j=1,nbp_lat
     607                     DO i=1,nbp_lon
     608                        varyear(i,j,k,imth) = varmth(i,nbp_lat+1-j,k)
     609                     END DO
     610                  END DO
     611               END DO
    502612             
    503              ! Invert latitudes for surface pressure
    504              vartmp(:,:) = psurf_glo2D(:,:,imth)
    505              DO j=1,nbp_lat
    506                 DO i=1,nbp_lon
    507                    psurf_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)
    508                 END DO
    509              END DO
     613               ! Invert latitudes for surface pressure
     614               vartmp(:,:) = psurf_glo2D(:,:,imth)
     615               DO j=1,nbp_lat
     616                  DO i=1,nbp_lon
     617                     psurf_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)
     618                  END DO
     619               END DO
    510620             
    511              ! Invert latitudes for the load
    512              vartmp(:,:) = load_glo2D(:,:,imth)
    513              DO j=1,nbp_lat
    514                 DO i=1,nbp_lon
    515                    load_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)
    516                 END DO
    517              END DO
    518           END IF ! invert_lat
     621               ! Invert latitudes for the load
     622               vartmp(:,:) = load_glo2D(:,:,imth)
     623               DO j=1,nbp_lat
     624                  DO i=1,nbp_lon
     625                     load_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)
     626                  END DO
     627               END DO
     628            END IF ! invert_lat
    519629             
    520           ! Do zonal mead at poles and distribut at whole first and last latitude
    521           DO k=1, klev_src
    522              npole=0.  ! North pole, j=1
    523              spole=0.  ! South pole, j=nbp_lat       
    524              DO i=1,nbp_lon
    525                 npole = npole + varyear(i,1,k,imth)
    526                 spole = spole + varyear(i,nbp_lat,k,imth)
    527              END DO
    528              npole = npole/REAL(nbp_lon)
    529              spole = spole/REAL(nbp_lon)
    530              varyear(:,1,    k,imth) = npole
    531              varyear(:,nbp_lat,k,imth) = spole
    532           END DO
    533        END DO ! imth
     630            ! Do zonal mead at poles and distribut at whole first and last latitude
     631            DO k=1, klev_src
     632               npole=0.  ! North pole, j=1
     633               spole=0.  ! South pole, j=nbp_lat       
     634               DO i=1,nbp_lon
     635                  npole = npole + varyear(i,1,k,imth)
     636                  spole = spole + varyear(i,nbp_lat,k,imth)
     637               END DO
     638               npole = npole/REAL(nbp_lon)
     639               spole = spole/REAL(nbp_lon)
     640               varyear(:,1,    k,imth) = npole
     641               varyear(:,nbp_lat,k,imth) = spole
     642            END DO
     643         END DO ! imth
    534644       
    535        ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr)
    536        IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 3',1)
     645         ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr)
     646         IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 3',1)
    537647       
    538        ! Transform from 2D to 1D field
    539        CALL grid2Dto1D_glo(varyear,varyear_glo1D)
    540        CALL grid2Dto1D_glo(psurf_glo2D,psurf_glo1D)
    541        CALL grid2Dto1D_glo(load_glo2D,load_glo1D)
    542 
     648         ! Transform from 2D to 1D field
     649         CALL grid2Dto1D_glo(varyear,varyear_glo1D)
     650         CALL grid2Dto1D_glo(psurf_glo2D,psurf_glo1D)
     651         CALL grid2Dto1D_glo(load_glo2D,load_glo1D)
     652     
     653      ENDIF
     654     
    543655    ELSE
    544       ALLOCATE(varyear_glo1D(0,0,0))       
     656        ALLOCATE(varyear_glo1D(0,0,0))       
    545657    END IF ! is_mpi_root .AND. is_omp_root
    546658
    … …  
    566678    IF (ASSOCIATED(pt_year)) DEALLOCATE(pt_year)
    567679    ALLOCATE(pt_year(klon, klev_src, 12), stat=ierr)
     680    ALLOCATE(pt_year_mpi(klon_mpi, klev_src, 12), stat=ierr)
    568681    IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 5',1)
    569682
    570     ! Scatter global field to local domain at local process
    571     CALL scatter(varyear_glo1D, pt_year)
    572     CALL scatter(psurf_glo1D, psurf_out)
    573     CALL scatter(load_glo1D,  load_out)
    574 
     683    IF (grid_type==unstructured) THEN
     684      IF (is_omp_master) THEN
     685        CALL xios_send_field(TRIM(varname)//"_in",varyear)
     686        CALL xios_recv_field(TRIM(varname)//"_out",pt_year_mpi)
     687        CALL xios_send_field("load_"//TRIM(varname)//"_in",load_glo2D)
     688        CALL xios_recv_field("load_"//TRIM(varname)//"_out",load_out_mpi)
     689        IF (first) THEN
     690          ALLOCATE(psurf_interp(klon_mpi,12))
     691          CALL xios_send_field("psurf_aerosol_in",psurf_glo2D)
     692          CALL xios_recv_field("psurf_aerosol_out",psurf_interp)
     693        ENDIF
     694      ENDIF
     695      CALL scatter_omp(pt_year_mpi,pt_year)
     696      CALL scatter_omp(load_out_mpi,load_out)
     697      CALL scatter_omp(psurf_interp,psurf_out)
     698      first=.FALSE.
     699    ELSE
     700      ! Scatter global field to local domain at local process
     701      CALL scatter(varyear_glo1D, pt_year)
     702      CALL scatter(psurf_glo1D, psurf_out)
     703      CALL scatter(load_glo1D,  load_out)
     704    ENDIF
    575705! 7) Test for negative values
    576706!****************************************************************************************

  • LMDZ6/trunk/libf/phylmd/readaerosolstrato.F90

    r2745 r3435  
    77    USE phys_cal_mod, ONLY : mth_cur
    88    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, &
    9                                  grid2dto1d_glo
     9                                 grid2dto1d_glo, grid_type, unstructured
    1010    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    1111    USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
    … …  
    1515    USE aero_mod
    1616    USE dimphy
     17    USE xios
    1718
    1819    implicit none
    … …  
    4344    real, allocatable:: tauaerstrat_mois(:, :, :)
    4445    real, allocatable:: tauaerstrat_mois_glo(:, :)
     46    real, allocatable:: tau_aer_strat_mpi(:, :)
    4547
    4648! For NetCDF:
    … …  
    8789    n_lat = size(latitude)
    8890    print *, 'LAT aerosol strato=', n_lat, latitude
    89     IF (n_lat.NE.nbp_lat) THEN
    90        print *,'Le nombre de lat n est pas egal a nbp_lat'
    91        STOP
    92     ENDIF
    93 
     91    IF (grid_type/=unstructured) THEN
     92      IF (n_lat.NE.nbp_lat) THEN
     93         print *,'Le nombre de lat n est pas egal a nbp_lat'
     94         STOP
     95      ENDIF
     96    ENDIF
     97   
    9498    CALL nf95_inq_varid(ncid_in, "LON", varid)
    9599    CALL nf95_gw_var(ncid_in, varid, longitude)
    96100    n_lon = size(longitude)
    97     print *, 'LON aerosol strato=', n_lon, longitude
    98     IF (n_lon.NE.nbp_lon) THEN
    99        print *,'Le nombre de lon n est pas egal a nbp_lon'
    100        STOP
    101     ENDIF
    102 
     101    IF (grid_type/=unstructured) THEN
     102      print *, 'LON aerosol strato=', n_lon, longitude
     103      IF (n_lon.NE.nbp_lon) THEN
     104         print *,'Le nombre de lon n est pas egal a nbp_lon'
     105         STOP
     106      ENDIF
     107    ENDIF
     108   
    103109    CALL nf95_inq_varid(ncid_in, "TIME", varid)
    104110    CALL nf95_gw_var(ncid_in, varid, time)
    … …  
    130136    CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo)
    131137
     138    ELSE
     139      ALLOCATE(tauaerstrat_mois(0,0,0))
    132140    ENDIF !--is_mpi_root and is_omp_root
    133141
    134142!$OMP BARRIER
    135143
     144    IF (grid_type==unstructured) THEN
     145      IF (is_omp_master) THEN
     146        CALL xios_send_field("taustrat_in",tauaerstrat_mois)
     147        ALLOCATE(tau_aer_strat_mpi(klon_mpi, klev))
     148        CALL xios_recv_field("taustrat_out",tau_aer_strat_mpi)
     149      ELSE
     150        ALLOCATE(tau_aer_strat_mpi(0,0))
     151      ENDIF
     152      CALL scatter_omp(tau_aer_strat_mpi,tau_aer_strat)
     153    ELSE 
    136154!--scatter on all proc
    137     CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
     155      CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
     156    ENDIF
    138157
    139158!--keep memory of previous month

  • LMDZ6/trunk/libf/phylmd/regr_horiz_time_climoz_m.F90

    r3278 r3435  
    22
    33  USE interpolation,     ONLY: locate
    4   USE mod_grid_phy_lmdz, ONLY: nlon_ou => nbp_lon, nlat_ou => nbp_lat
     4  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
    55  USE nrtype,            ONLY: pi
    66  USE netcdf,   ONLY: NF90_CLOBBER, NF90_FLOAT,     NF90_GET_VAR, NF90_OPEN,   &
    … …  
    1111          NF95_CLOSE, NF95_ENDDEF,  NF95_PUT_ATT,   NF95_PUT_VAR, NF95_COPY_ATT
    1212  USE print_control_mod, ONLY: lunout
     13  USE dimphy
    1314  IMPLICIT NONE
    1415  PRIVATE
    … …  
    1617  REAL, PARAMETER :: deg2rad=pi/180.
    1718  CHARACTER(LEN=13), PARAMETER :: vars_in(2)=['tro3         ','tro3_daylight']
     19
     20  INTEGER :: nlat_ou, nlon_ou
     21  REAL, ALLOCATABLE :: latitude_glo(:)
     22!$OMP THREADPRIVATE(latitude_glo)
     23  INTEGER, ALLOCATABLE :: ind_cell_glo_glo(:)
     24!$OMP THREADPRIVATE(ind_cell_glo_glo)
    1825
    1926CONTAINS
    … …  
    5259  USE assert_m,           ONLY: assert
    5360  USE cal_tools_m,        ONLY: year_len, mid_month
    54   USE control_mod,        ONLY: anneeref
     61!!  USE control_mod,        ONLY: anneeref
     62  USE time_phylmdz_mod,   ONLY: annee_ref
    5563  USE ioipsl,             ONLY: ioget_year_len, ioget_calendar
    5664  USE regr_conserv_m,     ONLY: regr_conserv
    … …  
    5866  USE regular_lonlat_mod, ONLY: boundslon_reg, boundslat_reg, south, west, east
    5967  USE slopes_m,           ONLY: slopes
     68  USE xios
     69  USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi
     70  USE geometry_mod, ONLY : latitude_deg, ind_cell_glo
     71  USE mod_grid_phy_lmdz, ONLY: klon_glo
     72
    6073!-------------------------------------------------------------------------------
    6174! Arguments:
    … …  
    8396  CHARACTER(LEN=20) :: cal_in              ! Calendar
    8497  REAL, ALLOCATABLE :: o3_in3(:,:,:,:,:)   ! Ozone climatologies
     98  REAL, ALLOCATABLE :: o3_in3bis(:,:,:,:,:)   ! Ozone climatologies
    8599  REAL, ALLOCATABLE :: o3_in2  (:,:,:,:)   ! Ozone climatologies
     100  REAL, ALLOCATABLE :: o3_in2bis(:,:,:,:,:)   ! Ozone climatologies
    86101  ! last index: 1 for the day-night average, 2 for the daylight field.
    87102  REAL :: NaN
    … …  
    91106  REAL, ALLOCATABLE :: o3_regr_lonlat(:,:,:,:,:) ! (nlon_ou,nlat_ou,:,0:13   ,:)
    92107  REAL, ALLOCATABLE :: o3_out3       (:,:,:,:,:) ! (nlon_ou,nlat_ou,:,ntim_ou,:)
     108  REAL, ALLOCATABLE :: o3_out3_glo   (:,:,:,:) !   (nbp_lat,:,ntim_ou,:)
    93109  REAL, ALLOCATABLE :: o3_regr_lat     (:,:,:,:) !         (nlat_in,:,0:13   ,:)
    94110  REAL, ALLOCATABLE :: o3_out2         (:,:,:,:) !         (nlat_ou,:,ntim_ou,:)
     111  REAL, ALLOCATABLE :: o3_out2_glo     (:,:,:,:) !         (nbp_lat,:,ntim_ou,:)
     112  REAL, ALLOCATABLE :: o3_out          (:,:,:,:) !         (nbp_lat,:,ntim_ou,:)
    95113! Dimension number  | Interval                | Contains  | For variables:
    96114!   1 (longitude)   | [rlonu(i-1), rlonu(i)]  | rlonv(i)  | all
    … …  
    116134  INTEGER, ALLOCATABLE :: sta(:), cnt(:)
    117135  CHARACTER(LEN=80) :: sub, dim_nam, msg
    118 !-------------------------------------------------------------------------------
    119   sub="regr_horiz_time_climoz"
    120   WRITE(lunout,*)"Call sequence information: "//TRIM(sub)
    121   CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz")
    122 
    123   CALL  NF95_OPEN("climoz.nc"  , NF90_NOWRITE, fID_in)
    124   lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==NF90_NOERR
    125   lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==NF90_NOERR
    126 
    127   !--- Get coordinates from the input file. Converts lon/lat in radians.
    128   !    Few inversions because "regr_conserv" and gcm need ascending vectors.
    129   CALL NF95_INQ_VARID(fID_in, vars_in(1), varid)
    130   CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims)
    131   l3D=ndims==4; l2D=ndims==3
    132   IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields."
    133   IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields."
    134   DO i=1,ndims
    135     CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln)
    136     CALL NF95_INQ_VARID(fID_in, dim_nam, varid)
    137     ii=i; IF(l2D) ii=i+1                              !--- ndims==3:NO LONGITUDE
    138     SELECT CASE(ii)
    139       CASE(1)                                         !--- LONGITUDE
    140         CALL NF95_GW_VAR(fID_in, varid, lon_in)
    141         ldec_lon=lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1)
    142         nlon_in=dln; lon_in=lon_in*deg2rad
    143       CASE(2)                                         !--- LATITUDE
    144         CALL NF95_GW_VAR(fID_in, varid, lat_in)
    145         ldec_lat=lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1)
    146         nlat_in=dln; lat_in=lat_in*deg2rad
    147       CASE(3)                                         !--- PRESSURE LEVELS
    148         CALL NF95_GW_VAR(fID_in, varid, lev_in)
    149         ldec_lev=lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1)
    150         nlev_in=dln
    151         CALL NF95_GET_ATT(fID_in, varid, "units", press_unit)
    152         k=LEN_TRIM(press_unit)
    153         DO WHILE(ICHAR(press_unit(k:k))==0)
    154           press_unit(k:k)=' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR
    155         END DO
    156         IF(press_unit ==  "Pa") THEN
    157           lev_in = lev_in/100.                        !--- CONVERT TO hPa
    158         ELSE IF(press_unit /= "hPa") THEN
    159           CALL abort_physic(sub, "the only recognized units are Pa and hPa.",1)
    160         END IF
    161       CASE(4)                                         !--- TIME
    162         CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in)
    163         cal_in='gregorian'
    164         IF(NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=NF90_NOERR)        &
    165           WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'//       &
    166           TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".'
    167         k=LEN_TRIM(cal_in)
    168         DO WHILE(ICHAR(cal_in(k:k))==0)
    169           cal_in(k:k)=' '; k=LEN_TRIM(cal_in)         !--- REMOVE NULL END CHAR
    170         END DO
    171     END SELECT
    172   END DO
    173 
    174   !--- Longitudes management:
    175   !    * Need to shift data if the origin of input file longitudes /= -pi
    176   !    * Need to add some margin in longitude to ensure input interval contains
    177   !      all the output intervals => at least one longitudes slice has to be
    178   !      duplicated, possibly more for undersampling.
    179   IF(l3D) THEN
    180     !--- Compute input edges longitudes vector (no end point yet)
    181     ALLOCATE(v1(nlon_in+1))
    182     v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi
    183     FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2.
    184     v1(nlon_in+1)=v1(1)+2.*pi
    185     DEALLOCATE(lon_in)
    186 
    187     !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west)
    188     v1=v1+2*pi*REAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi)))
     136  REAL :: null_array(0)
     137  LOGICAL,SAVE :: first=.TRUE.
     138!$OMP THREADPRIVATE(first) 
     139  REAL, ALLOCATABLE :: test_o3_in(:,:)
     140  REAL, ALLOCATABLE :: test_o3_out(:)
     141
     142
     143  IF (grid_type==unstructured) THEN
     144    IF (first) THEN
     145      IF (is_master) THEN
     146        ALLOCATE(latitude_glo(klon_glo))
     147        ALLOCATE(ind_cell_glo_glo(klon_glo))
     148      ELSE
     149        ALLOCATE(latitude_glo(0))
     150        ALLOCATE(ind_cell_glo_glo(0))
     151      ENDIF
     152      CALL gather(latitude_deg,  latitude_glo)
     153      CALL gather(ind_cell_glo,  ind_cell_glo_glo)
     154    ENDIF
     155  ENDIF
     156   
     157  IF (is_omp_master) THEN
     158    nlat_ou=nbp_lat
     159    nlon_ou=nbp_lon
     160   
     161   !-------------------------------------------------------------------------------
     162    IF (is_mpi_root) THEN
     163      sub="regr_horiz_time_climoz"
     164      WRITE(lunout,*)"Call sequence information: "//TRIM(sub)
     165      CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz")
     166
     167      CALL  NF95_OPEN("climoz.nc"  , NF90_NOWRITE, fID_in)
     168      lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==NF90_NOERR
     169      lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==NF90_NOERR
     170
     171      !--- Get coordinates from the input file. Converts lon/lat in radians.
     172      !    Few inversions because "regr_conserv" and gcm need ascending vectors.
     173      CALL NF95_INQ_VARID(fID_in, vars_in(1), varid)
     174      CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims)
     175      l3D=ndims==4; l2D=ndims==3
     176      IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields."
     177      IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields."
     178      DO i=1,ndims
     179        CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln)
     180        CALL NF95_INQ_VARID(fID_in, dim_nam, varid)
     181        ii=i; IF(l2D) ii=i+1                              !--- ndims==3:NO LONGITUDE
     182        SELECT CASE(ii)
     183          CASE(1)                                         !--- LONGITUDE
     184            CALL NF95_GW_VAR(fID_in, varid, lon_in)
     185            ldec_lon=lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1)
     186            nlon_in=dln; lon_in=lon_in*deg2rad
     187          CASE(2)                                         !--- LATITUDE
     188            CALL NF95_GW_VAR(fID_in, varid, lat_in)
     189            ldec_lat=lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1)
     190            nlat_in=dln; lat_in=lat_in*deg2rad
     191          CASE(3)                                         !--- PRESSURE LEVELS
     192            CALL NF95_GW_VAR(fID_in, varid, lev_in)
     193            ldec_lev=lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1)
     194            nlev_in=dln
     195            CALL NF95_GET_ATT(fID_in, varid, "units", press_unit)
     196            k=LEN_TRIM(press_unit)
     197            DO WHILE(ICHAR(press_unit(k:k))==0)
     198              press_unit(k:k)=' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR
     199            END DO
     200            IF(press_unit ==  "Pa") THEN
     201              lev_in = lev_in/100.                        !--- CONVERT TO hPa
     202            ELSE IF(press_unit /= "hPa") THEN
     203              CALL abort_physic(sub, "the only recognized units are Pa and hPa.",1)
     204            END IF
     205          CASE(4)                                         !--- TIME
     206            CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in)
     207            cal_in='gregorian'
     208            IF(NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=NF90_NOERR)        & 
     209            WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'//       &
     210            TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".'
     211            k=LEN_TRIM(cal_in)
     212            DO WHILE(ICHAR(cal_in(k:k))==0)
     213              cal_in(k:k)=' '; k=LEN_TRIM(cal_in)         !--- REMOVE NULL END CHAR
     214            END DO
     215        END SELECT
     216      END DO
    189217
    190218    !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west)
    191219    dx1=locate(v1,boundslon_reg(1,west))-1
    192220    v1=CSHIFT(v1,SHIFT=dx1,DIM=1); v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi
    193 
    194221    !--- Extend input longitudes vector until last interval contains boundslon_reg(nlon_ou,east)
    195222    dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
    196223
    197     !--- Final edges longitudes vector (with margin and end point)
    198     ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi]
    199     DEALLOCATE(v1)
    200   END IF
    201 
    202   !--- Compute sinus of intervals edges latitudes:
    203   ALLOCATE(sinlat_in_edge(nlat_in+1))
    204   sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1.
    205   FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.)
    206   DEALLOCATE(lat_in)
    207 
    208   !--- Prepare quantities for time interpolation
    209   tmidmonth=mid_month(anneeref, cal_in)
    210   IF(interpt) THEN
    211     ntim_ou=ioget_year_len(anneeref)
    212     ALLOCATE(tmidday(ntim_ou))
    213     tmidday=[(REAL(k)-0.5,k=1,ntim_ou)]
    214     CALL ioget_calendar(cal_ou)
    215   ELSE
    216     ntim_ou=14
    217     cal_ou=cal_in
    218   END IF
    219 
    220   !--- Create the output file and get the variable IDs:
    221   CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, &
    222                    ndims, cal_ou)
    223 
    224   !--- Write remaining coordinate variables:
    225   CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in)
    226   IF(     interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday)
    227   IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth)
    228 
    229   !--- Check for contiguous years:
    230   ib=0; ie=13
    231   IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE.
    232     WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...'
    233   ELSE
    234     IF(     lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).'
    235     IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity."
    236     IF(     lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).'
    237     IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity."
    238     IF(.NOT.lprev) ib=1
    239     IF(.NOT.lnext) ie=12
    240   END IF
    241   ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1
    242   IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1]
    243   IF(l2D) cnt=[        nlat_in,nlev_in,1]
    244   IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz))
    245   IF(l2D) ALLOCATE(o3_in2(            nlat_in,nlev_in,ib:ie,read_climoz))
    246 
    247   !--- Read full current file and one record each available contiguous file
    248   DO iv=1,read_climoz
    249     msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv))
    250     CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv))
    251     IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv))
    252     IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2(          :,:,1:12,iv))
    253     CALL handle_err(TRIM(msg), ncerr, fID_in)
    254     IF(lprev) THEN; sta(ndims)=12
    255       CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv))
    256       IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt)
    257       IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2(          :,:, 0,iv),sta,cnt)
    258       CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m)
     224      IF (first) THEN
     225        first=.FALSE.
     226        RETURN
     227      ENDIF
     228    ENDIF
     229   
     230   
     231    IF (is_mpi_root) THEN     
     232      !--- Longitudes management:
     233      !    * Need to shift data if the origin of input file longitudes /= -pi
     234      !    * Need to add some margin in longitude to ensure input interval contains
     235      !      all the output intervals => at least one longitudes slice has to be
     236      !      duplicated, possibly more for undersampling.
     237      IF(l3D) THEN
     238        IF (grid_type==unstructured) THEN
     239          dx2=0
     240        ELSE
     241          !--- Compute input edges longitudes vector (no end point yet)
     242          ALLOCATE(v1(nlon_in+1))
     243          v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi
     244          FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2.
     245          v1(nlon_in+1)=v1(1)+2.*pi
     246          DEALLOCATE(lon_in)
     247
     248          !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west)
     249          v1=v1+2*pi*REAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi)))
     250
     251          !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west)
     252          dx1=locate(v1,boundslon_reg(1,west))-1
     253          v1=CSHIFT(v1,SHIFT=dx1,DIM=1)
     254          v1(nlon_in-dx1+1:)=v1(nlon_in-dx1+1:)+2.*pi
     255   
     256          !--- Extend input longitudes vector until last interval contains boundslon_reg(nlat_ou,east)
     257          dx2=0; DO WHILE(v1(1+dx2)+2.*pi<boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
     258
     259          !--- Final edges longitudes vector (with margin and end point)
     260          ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi]
     261          DEALLOCATE(v1)
     262        ENDIF
     263      END IF
     264
     265      !--- Compute sinus of intervals edges latitudes:
     266      ALLOCATE(sinlat_in_edge(nlat_in+1))
     267      sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1.
     268      FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.)
     269      DEALLOCATE(lat_in)
     270
     271
     272
     273      !--- Check for contiguous years:
     274      ib=0; ie=13
     275      IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE.
     276        WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...'
     277      ELSE 
     278        IF(     lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).'
     279        IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity."
     280        IF(     lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).'
     281        IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity."
     282        IF(.NOT.lprev) ib=1
     283        IF(.NOT.lnext) ie=12
     284      END IF
     285      ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1 
     286      IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1]
     287      IF(l2D) cnt=[        nlat_in,nlev_in,1] 
     288      IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz))
     289      IF(l2D) ALLOCATE(o3_in2(            nlat_in,nlev_in,ib:ie,read_climoz))
     290
     291      !--- Read full current file and one record each available contiguous file
     292      DO iv=1,read_climoz
     293        msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv))
     294        CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv))
     295        IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv))
     296        IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2(          :,:,1:12,iv))
     297        CALL handle_err(TRIM(msg), ncerr, fID_in)
     298        IF(lprev) THEN; sta(ndims)=12 
     299          CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv))
     300          IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt)
     301          IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2(          :,:, 0,iv),sta,cnt)
     302          CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m)
     303        END IF
     304        IF(lnext) THEN; sta(ndims)=1 
     305          CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv))
     306          IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt)
     307          IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2(          :,:,13,iv),sta,cnt)
     308          CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p)
     309        END IF
     310      END DO
     311      IF(lprev.OR.lnext) DEALLOCATE(sta,cnt)
     312      IF(lprev) CALL NF95_CLOSE(fID_in_m)
     313      IF(lnext) CALL NF95_CLOSE(fID_in_p)
     314
     315      !--- Revert decreasing coordinates vector
     316      IF(l3D) THEN
     317        IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:)
     318        IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:)
     319        IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:)
     320       
     321        IF (grid_type /= unstructured) THEN
     322          !--- Shift values for longitude and duplicate some longitudes slices
     323          o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1)
     324          o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:)
     325        ENDIF
     326      ELSE
     327        IF(ldec_lat) o3_in2 = o3_in2(  nlat_in:1:-1,:,:,:)
     328        IF(ldec_lev) o3_in2 = o3_in2(  :,nlev_in:1:-1,:,:)
     329      END IF
     330
     331     !--- Deal with missing values
     332      DO m=1, read_climoz
     333        WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m
     334        IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= NF90_NOERR) THEN
     335          IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= NF90_NOERR) THEN
     336            WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE
     337          END IF
     338        END IF
     339        WRITE(lunout,*)TRIM(msg)//": missing value attribute found."
     340        WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better."
     341
     342        !--- Check top layer contains no NaNs & search NaNs from top to ground
     343        msg=TRIM(sub)//": NaNs in top layer !"
     344        IF(l3D) THEN
     345          IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1)
     346          DO k = 2,nlev_in
     347            WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m)
     348          END DO
     349        ELSE
     350          IF(ANY(o3_in2(  :,1,:,m)==NaN)) THEN
     351            WRITE(lunout,*)msg
     352            !--- Fill in latitudes where all values are missing
     353            DO l=1,nmth_in
     354              !--- Next to south pole
     355              j=1;       DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
     356              IF(j>1) &
     357                o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1)
     358              !--- Next to north pole
     359              j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
     360              IF(j<nlat_in) &
     361                o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j)
     362            END DO
     363          END IF
     364
     365          !--- Fill in high latitudes missing values
     366          !--- Highest level been filled-in, so has always valid values.
     367          DO k = 2,nlev_in
     368            WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m)
     369          END DO
     370        END IF
     371      END DO
     372
     373    ENDIF
     374   
     375    !=============================================================================
     376    IF(l3D) THEN                                                   !=== 3D FIELDS
     377    !=============================================================================
     378     IF (grid_type==unstructured) THEN
     379       nlat_ou=klon_mpi
     380       
     381       IF (is_mpi_root) THEN
     382         ALLOCATE(o3_in3bis(nlon_in,nlat_in,nlev_in,0:13,read_climoz))
     383         o3_in3bis(:,:,:,ib:ie,:)=o3_in3(1:nlon_in,:,:,ib:ie,:)
     384       ELSE
     385         ALLOCATE(o3_in3bis(0,0,0,0,read_climoz))
     386       ENDIF
     387       ALLOCATE(o3_regr_lonlat(1, nlat_ou, nlev_in, 0:13, read_climoz))
     388       
     389       CALL xios_send_field("tro3_in",o3_in3bis(:,:,:,:,:))
     390       CALL xios_recv_field("tro3_out",o3_regr_lonlat(1,:,:,:,:))
     391
     392     ELSE
     393         
     394       !--- Regrid in longitude
     395        ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz))
     396        CALL regr_conserv(1, o3_in3, xs = lon_in_edge,                             &
     397                            xt = [boundslon_reg(1,west),boundslon_reg(:,east)],    &
     398                            vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge))
     399        DEALLOCATE(o3_in3)
     400
     401        !--- Regrid in latitude: averaging with respect to SIN(lat) is
     402        !                        equivalent to weighting by COS(lat)
     403        !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing)
     404        ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz))
     405        CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge,                     &
     406                        xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
     407                        vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:),            &
     408                   slope = slopes(2,o3_regr_lon, sinlat_in_edge))
     409        DEALLOCATE(o3_regr_lon)
     410
     411     ENDIF
     412
     413     !--- Duplicate previous/next record(s) if they are not available
     414     IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:)
     415     IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:)
     416     
     417     !--- Regrid in time by linear interpolation:
     418     ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz))
     419     IF(     interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3)
     420     IF(.NOT.interpt) o3_out3=o3_regr_lonlat
     421     DEALLOCATE(o3_regr_lonlat)
     422
     423     nlat_ou=nbp_lat
     424     IF (grid_type==unstructured) THEN
     425       CALL xios_send_field('o3_out',o3_out3)
     426       ndims=3
     427       ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
     428       CALL gather_mpi(o3_out3(1,:,:,:,:), o3_out3_glo)
     429     ENDIF
     430
     431    !--- Create the output file and get the variable IDs:
     432    CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, &
     433                     ndims, cal_ou)
     434
     435    IF (is_mpi_root) THEN
     436      !--- Write remaining coordinate variables:
     437      CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in)
     438      IF(     interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday)
     439      IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth)
     440
     441      !--- Write to file (the order of "rlatu" is inverted in the output file):
     442        IF (grid_type==unstructured) THEN
     443
     444          ALLOCATE(o3_out(nlat_ou, nlev_in, ntim_ou, read_climoz))
     445          DO i=1,klon_glo
     446            o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out3_glo(i,:,:,:)
     447          ENDDO
     448
     449          DO m = 1, read_climoz
     450            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m))
     451          END DO
     452         
     453        ELSE
     454          DO m = 1, read_climoz
     455            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m))
     456          END DO
     457      ENDIF
     458      CALL NF95_CLOSE(fID_ou)
     459
     460
     461    ENDIF
     462
     463
     464    !=============================================================================
     465    ELSE                                                         !=== ZONAL FIELDS
     466    !=============================================================================
     467   
     468     IF (grid_type==unstructured) THEN
     469       nlat_ou=klon_mpi
     470
     471       IF (is_mpi_root) THEN
     472         ALLOCATE(o3_in2bis(8,nlat_in,nlev_in,0:13,read_climoz))
     473         o3_in2bis(:,:,:,ib:ie,:)=SPREAD(o3_in2,1,8)
     474       ELSE
     475         ALLOCATE(o3_in2bis(0,0,0,0,read_climoz))
     476       ENDIF
     477       ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz))
     478       CALL xios_send_field("tro3_in",o3_in2bis(:,:,:,:,:))
     479       CALL xios_recv_field("tro3_out",o3_regr_lat(:,:,:,:))
     480       IF(.NOT.lprev) o3_regr_lat(:,:, 0, :) = o3_regr_lat(:,:,12,:)
     481       IF(.NOT.lnext) o3_regr_lat(:,:,13, :) = o3_regr_lat(:,:, 1,:)
     482       
     483     
     484     ELSE
     485        !--- Regrid in latitude: averaging with respect to SIN(lat) is
     486        !                        equivalent to weighting by COS(lat)
     487        !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing)
     488        ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz))
     489        CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge,                          &
     490                        xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
     491                        vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:),                 &
     492                     slope = slopes(1,o3_in2, sinlat_in_edge))
     493        DEALLOCATE(o3_in2)
     494
     495        !--- Duplicate previous/next record(s) if they are not available
     496        IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:)
     497        IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:)
     498
     499     ENDIF
     500     
     501      !--- Regrid in time by linear interpolation:
     502      ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz))
     503      IF(     interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2)
     504      IF(.NOT.interpt) o3_out2=o3_regr_lat
     505      DEALLOCATE(o3_regr_lat)
     506
     507      nlat_ou=nbp_lat
     508   
     509      IF (grid_type==unstructured) THEN
     510        ndims=3
     511        ALLOCATE(o3_out2_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
     512        CALL gather_mpi(o3_out2, o3_out2_glo)
     513      ENDIF
     514     
     515      !--- Create the output file and get the variable IDs:
     516      CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, &
     517                         ndims, cal_ou)
     518
     519      IF (is_mpi_root) THEN
     520     
     521        !--- Write remaining coordinate variables:
     522        CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in)
     523        IF(     interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday)
     524        IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth)
     525
     526        IF (grid_type==unstructured) THEN
     527
     528          ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz))
     529          DO i=1,klon_glo
     530            o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out2_glo(i,:,:,:)
     531          ENDDO
     532
     533
     534          DO m = 1, read_climoz
     535            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m))
     536          END DO
     537        ELSE
     538          !--- Write to file (the order of "rlatu" is inverted in the output file):
     539          DO m = 1, read_climoz
     540            CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m))
     541          END DO
     542        ENDIF
     543       
     544        CALL NF95_CLOSE(fID_ou)
     545     
     546      ENDIF
     547
     548    !=============================================================================
    259549    END IF
    260     IF(lnext) THEN; sta(ndims)=1
    261       CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv))
    262       IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt)
    263       IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2(          :,:,13,iv),sta,cnt)
    264       CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p)
    265     END IF
    266   END DO
    267   IF(lprev.OR.lnext) DEALLOCATE(sta,cnt)
    268   IF(lprev) CALL NF95_CLOSE(fID_in_m)
    269   IF(lnext) CALL NF95_CLOSE(fID_in_p)
    270 
    271   !--- Revert decreasing coordinates vector
    272   IF(l3D) THEN
    273     IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:)
    274     IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:)
    275     IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:)
    276     !--- Shift values for longitude and duplicate some longitudes slices
    277     o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1)
    278     o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:)
    279   ELSE
    280     IF(ldec_lat) o3_in2 = o3_in2(  nlat_in:1:-1,:,:,:)
    281     IF(ldec_lev) o3_in2 = o3_in2(  :,nlev_in:1:-1,:,:)
    282   END IF
    283 
    284  !--- Deal with missing values
    285   DO m=1, read_climoz
    286     WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m
    287     IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= NF90_NOERR) THEN
    288       IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= NF90_NOERR) THEN
    289         WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE
    290       END IF
    291     END IF
    292     WRITE(lunout,*)TRIM(msg)//": missing value attribute found."
    293     WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better."
    294 
    295     !--- Check top layer contains no NaNs & search NaNs from top to ground
    296     msg=TRIM(sub)//": NaNs in top layer !"
    297     IF(l3D) THEN
    298       IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1)
    299       DO k = 2,nlev_in
    300         WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m)
    301       END DO
    302     ELSE
    303       IF(ANY(o3_in2(  :,1,:,m)==NaN)) THEN
    304         WRITE(lunout,*)msg
    305         !--- Fill in latitudes where all values are missing
    306         DO l=1,nmth_in
    307           !--- Next to south pole
    308           j=1;       DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
    309           IF(j>1) &
    310             o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1)
    311           !--- Next to north pole
    312           j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
    313           IF(j<nlat_in) &
    314             o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j)
    315         END DO
    316       END IF
    317 
    318       !--- Fill in high latitudes missing values
    319       !--- Highest level been filled-in, so has always valid values.
    320       DO k = 2,nlev_in
    321         WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m)
    322       END DO
    323     END IF
    324   END DO
    325   CALL NF95_CLOSE(fID_in)
    326 
    327   !=============================================================================
    328   IF(l3D) THEN                                                   !=== 3D FIELDS
    329   !=============================================================================
    330     !--- Regrid in longitude
    331     ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz))
    332     CALL regr_conserv(1, o3_in3, xs = lon_in_edge,                             &
    333                         xt = [boundslon_reg(1,west),boundslon_reg(:,east)],    &
    334                         vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge))
    335     DEALLOCATE(o3_in3)
    336 
    337     !--- Regrid in latitude: averaging with respect to SIN(lat) is
    338     !                        equivalent to weighting by COS(lat)
    339     !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing)
    340     ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz))
    341     CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge,                     &
    342                     xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
    343                     vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:),            &
    344                  slope = slopes(2,o3_regr_lon, sinlat_in_edge))
    345     DEALLOCATE(o3_regr_lon)
    346 
    347     !--- Duplicate previous/next record(s) if they are not available
    348     IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:)
    349     IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:)
    350 
    351     !--- Regrid in time by linear interpolation:
    352     ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz))
    353     IF(     interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3)
    354     IF(.NOT.interpt) o3_out3=o3_regr_lonlat
    355     DEALLOCATE(o3_regr_lonlat)
    356 
    357     !--- Write to file (the order of "rlatu" is inverted in the output file):
    358     DO m = 1, read_climoz
    359       CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m))
    360     END DO
    361 
    362   !=============================================================================
    363   ELSE                                                         !=== ZONAL FIELDS
    364   !=============================================================================
    365     !--- Regrid in latitude: averaging with respect to SIN(lat) is
    366     !                        equivalent to weighting by COS(lat)
    367     !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing)
    368     ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz))
    369     CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge,                          &
    370                     xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
    371                     vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:),                 &
    372                  slope = slopes(1,o3_in2, sinlat_in_edge))
    373     DEALLOCATE(o3_in2)
    374 
    375     !--- Duplicate previous/next record(s) if they are not available
    376     IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:)
    377     IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:)
    378 
    379     !--- Regrid in time by linear interpolation:
    380     ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz))
    381     IF(     interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2)
    382     IF(.NOT.interpt) o3_out2=o3_regr_lat
    383     DEALLOCATE(o3_regr_lat)
    384 
    385     !--- Write to file (the order of "rlatu" is inverted in the output file):
    386     DO m = 1, read_climoz
    387       CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m))
    388     END DO
    389 
    390   !=============================================================================
    391   END IF
    392   !=============================================================================
    393 
    394   CALL NF95_CLOSE(fID_ou)
    395 
     550    !=============================================================================
     551
     552    IF (is_mpi_root) CALL NF95_CLOSE(fID_in)
     553
     554  ENDIF ! is_omp_master
     555
     556  first=.FALSE.
    396557END SUBROUTINE regr_horiz_time_climoz
    397558!
    … …  
    408569!-------------------------------------------------------------------------------
    409570  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
     571  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
     572  USE mod_phys_lmdz_para, ONLY: is_mpi_root
     573  USE mod_grid_phy_lmdz, ONLY: klon_glo
     574!
    410575!-------------------------------------------------------------------------------
    411576! Arguments:
    … …  
    419584  INTEGER :: dlonID, dlatID, dlevID, dtimID, dIDs(4)
    420585  INTEGER :: vlonID, vlatID, ncerr,  is
     586  REAL,ALLOCATABLE    :: latitude_glo_(:)
    421587  CHARACTER(LEN=80) :: sub
    422 !-------------------------------------------------------------------------------
    423   sub="prepare_out"
    424   WRITE(lunout,*)"CALL sequence information: "//TRIM(sub)
    425   CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou)
     588  INTEGER :: i
     589
     590
     591!-------------------------------------------------------------------------------
     592 
     593  IF (is_mpi_root) THEN 
     594    sub="prepare_out"
     595    WRITE(lunout,*)"CALL sequence information: "//TRIM(sub)
     596    CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou)
    426597
    427598  !--- Dimensions:
    428   IF(ndims==4) &
    429   CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID)
    430   CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID)
    431   CALL NF95_DEF_DIM(fID_ou, "plev",  nlev_in, dlevID)
    432   CALL NF95_DEF_DIM(fID_ou, "time",  ntim_ou, dtimID)
    433 
    434   !--- Define coordinate variables:
    435   IF(ndims==4) &
    436   CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID)
    437   CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID)
    438   CALL NF95_DEF_VAR(fID_ou, "plev",  NF90_FLOAT, dlevID, vlevID)
    439   CALL NF95_DEF_VAR(fID_ou, "time",  NF90_FLOAT, dtimID, vtimID)
    440   IF(ndims==4) &
    441   CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east")
    442   CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north")
    443   CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar")
    444   CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1")
    445   IF(ndims==4) &
    446   CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude")
    447   CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude")
    448   CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure")
    449   CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time")
    450   CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name",     "air pressure")
    451   CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar",      cal_ou)
     599    IF(ndims==4) &
     600    CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID)
     601    CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID)
     602    CALL NF95_DEF_DIM(fID_ou, "plev",  nlev_in, dlevID)
     603    CALL NF95_DEF_DIM(fID_ou, "time",  ntim_ou, dtimID)
     604
     605    !--- Define coordinate variables:
     606    IF(ndims==4) &
     607    CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID)
     608    CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID)
     609    CALL NF95_DEF_VAR(fID_ou, "plev",  NF90_FLOAT, dlevID, vlevID)
     610    CALL NF95_DEF_VAR(fID_ou, "time",  NF90_FLOAT, dtimID, vtimID)
     611    IF(ndims==4) &
     612    CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east")
     613    CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north")
     614    CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar")
     615    CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1")
     616    IF(ndims==4) &
     617    CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude")
     618    CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude")
     619    CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure")
     620    CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time")
     621    CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name",     "air pressure")
     622    CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar",      cal_ou)
    452623
    453624  !--- Define the main variables:
    454   IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID]
    455   IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID]
    456   CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1))
    457   CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction")
    458   CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone&
     625    IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID]
     626    IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID]
     627    CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1))
     628    CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction")
     629    CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone&
    459630      &_in_air")
    460   IF(SIZE(vID_ou) == 2) THEN
    461     CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2))
    462     CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da&
    463       &ylight")
    464   END IF
     631    IF(SIZE(vID_ou) == 2) THEN
     632      CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2))
     633      CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da&
     634        &ylight")
     635    END IF
    465636
    466637  !--- Global attributes:
    467638  ! The following commands, copying attributes, may fail. That is OK.
    468639  ! It should just mean that the attribute is not defined in the input file.
    469   CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr)
    470   CALL handle_err_copy_att("Conventions")
    471   CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title",      fID_ou,NF90_GLOBAL, ncerr)
    472   CALL handle_err_copy_att("title")
    473   CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr)
    474   CALL handle_err_copy_att("institution")
    475   CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source",     fID_ou,NF90_GLOBAL, ncerr)
    476   CALL handle_err_copy_att("source")
    477   CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ")
    478   CALL NF95_ENDDEF(fID_ou)
    479 
    480   !--- Write one of the coordinate variables:
    481   IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad)
    482   CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad)
    483   !    (convert from rad to degrees and sort in ascending order)
    484 
     640    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr)
     641    CALL handle_err_copy_att("Conventions")
     642    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title",      fID_ou,NF90_GLOBAL, ncerr)
     643    CALL handle_err_copy_att("title")
     644    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr)
     645    CALL handle_err_copy_att("institution")
     646    CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source",     fID_ou,NF90_GLOBAL, ncerr)
     647    CALL handle_err_copy_att("source")
     648    CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ")
     649    CALL NF95_ENDDEF(fID_ou)
     650
     651    IF (grid_type==unstructured) THEN
     652      ALLOCATE(latitude_glo_(klon_glo))
     653      DO i=1,klon_glo
     654        latitude_glo_(ind_cell_glo_glo(i))=latitude_glo(i)
     655      ENDDO
     656      CALL NF95_PUT_VAR(fID_ou, vlatID, latitude_glo_)
     657    ELSE
     658      !--- Write one of the coordinate variables:
     659      IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad)
     660      CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad)
     661    !    (convert from rad to degrees and sort in ascending order)
     662    ENDIF
     663  ENDIF
     664 
    485665CONTAINS
    486666

  • LMDZ6/trunk/libf/phylmd/regr_pr_time_av_m.F90

    r3141 r3435  
    118118  USE assert_m,       ONLY: assert
    119119  USE assert_eq_m,    ONLY: assert_eq
    120   USE comvert_mod,    ONLY: scaleheight
     120!!  USE comvert_mod,    ONLY: scaleheight
    121121  USE interpolation,  ONLY: locate
    122122  USE regr_conserv_m, ONLY: regr_conserv
    123123  USE regr_lint_m,    ONLY: regr_lint
    124124  USE slopes_m,       ONLY: slopes
    125   USE mod_phys_lmdz_mpi_data,       ONLY: is_mpi_root
    126   USE mod_grid_phy_lmdz, ONLY: nlon=>nbp_lon, nlat=>nbp_lat, nlev_ou=>nbp_lev
    127   USE mod_phys_lmdz_transfert_para, ONLY: scatter2d, scatter
     125  USE mod_phys_lmdz_para,           ONLY: is_mpi_root,is_master
     126  USE mod_grid_phy_lmdz,            ONLY: nlon=>nbp_lon, nlat=>nbp_lat, nlev_ou=>nbp_lev, klon_glo, grid_type, unstructured
     127  USE mod_phys_lmdz_transfert_para, ONLY: scatter2d, scatter, gather
    128128  USE phys_cal_mod,                 ONLY: calend, year_len, days_elapsed, jH_cur
     129  USE geometry_mod,                 ONLY: ind_cell_glo
    129130!-------------------------------------------------------------------------------
    130131! Arguments:
    … …  
    175176    v2i(klon,SIZE(Pre_in)-1,SIZE(nam)), &     !--- v2 in Ploc=='I' case
    176177    v2c(klon,SIZE(Pre_in)  ,SIZE(nam))        !--- v2 in Ploc=='C' case
     178  INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:)
    177179  LOGICAL :: ll
    178180!--- For debug
    … …  
    255257    CALL bcast(lO3Tfile); CALL bcast(linterp)
    256258  END IF
     259 
     260  IF (is_master) THEN
     261    ALLOCATE(ind_cell_glo_glo(klon_glo))
     262  ELSE
     263    ALLOCATE(ind_cell_glo_glo(0))
     264  ENDIF
     265  CALL gather(ind_cell_glo,ind_cell_glo_glo)
     266  IF (is_master .AND. grid_type==unstructured) v1(:,:,:,:)=v1(:,ind_cell_glo_glo(:),:,:)
     267 
    257268  CALL scatter2d(v1,v2)
    258   IF(lPrSfile) CALL scatter2d(pg1,Pgnd_in)
    259   IF(lPrTfile) CALL scatter2d(pt1,Ptrp_in)
    260   IF(lO3Tfile) CALL scatter2d(ot1,Otrp_in)
     269
     270  !--- No "ps" in input file => assumed to be equal to current LMDZ ground press
     271  IF(lPrSfile) THEN
     272    IF (is_master .AND. grid_type==unstructured) pg1(:,:)=pg1(:,ind_cell_glo_glo(:))
     273    CALL scatter2d(pg1,Pgnd_in)
     274  ELSE
     275    Pgnd_in=Pre_ou(:,1)
     276  END IF
     277
     278  IF(lPrTfile) THEN
     279    IF (is_master .AND. grid_type==unstructured) pt1(:,:)=pt1(:,ind_cell_glo_glo(:))
     280    CALL scatter2d(pt1,Ptrp_in)
     281  ENDIF
     282
     283  IF(lO3Tfile) THEN
     284    IF (is_master .AND. grid_type==unstructured) ot1(:,:)=ot1(:,ind_cell_glo_glo(:))
     285    CALL scatter2d(ot1,Otrp_in)
     286  ENDIF
    261287  !--- No ground pressure in input file => choose it to be the one of LMDZ
    262288  IF(lAdjTro.AND..NOT.lPrSfile) Pgnd_in(:)=Pgrnd_ou(:)
    263  
    264 !-------------------------------------------------------------------------------
    265   IF(.NOT.lAdjTro) THEN       !--- REGRID IN PRESSURE ; NO TROPOPAUSE ADJUSTMENT
    266 !-------------------------------------------------------------------------------
     289
     290  !--- REGRID IN PRESSURE ; 3rd index inverted because "paprs" is decreasing
     291  IF(.NOT.lAdjTro) THEN
    267292    DO i=1,klon
    268293      Pres_ou=Pre_ou(i,SIZE(Pre_ou,2):1:-1)   !--- pplay & paprs are decreasing

  • LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90

    r2744 r3435  
    22! $Id: readaerosolstrato1_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
    33!
     4
    45SUBROUTINE readaerosolstrato1_rrtm(debut)
    56
    … …  
    910
    1011    USE phys_cal_mod, ONLY : mth_cur
    11     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo
    12     USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    13     USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     12    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
    1413    USE mod_phys_lmdz_para
    1514    USE phys_state_var_mod
    … …  
    1918    USE YOERAD, ONLY : NLW
    2019    USE YOMCST
     20    USE xios
    2121
    2222    IMPLICIT NONE
    … …  
    4545    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :)
    4646    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :)
     47    REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :)
    4748
    4849! For NetCDF:
    … …  
    102103    n_lat = size(latitude)
    103104    print *, 'LAT aerosol strato=', n_lat, latitude
    104     IF (n_lat.NE.nbp_lat) THEN
    105        print *,'Le nombre de lat n est pas egal a nbp_lat'
    106        STOP
    107     ENDIF
    108 
     105
     106    IF (grid_type/=unstructured) THEN
     107      IF (n_lat.NE.nbp_lat) THEN
     108         print *,'Le nombre de lat n est pas egal a nbp_lat'
     109         STOP
     110      ENDIF
     111    ENDIF
     112   
    109113    CALL nf95_inq_varid(ncid_in, "LON", varid)
    110114    CALL nf95_gw_var(ncid_in, varid, longitude)
    111115    n_lon = size(longitude)
    112116    print *, 'LON aerosol strato=', n_lon, longitude
    113     IF (n_lon.NE.nbp_lon) THEN
    114        print *,'Le nombre de lon n est pas egal a nbp_lon'
    115        STOP
    116     ENDIF
    117 
     117
     118    IF (grid_type/=unstructured) THEN
     119      IF (n_lon.NE.nbp_lon) THEN
     120         print *,'Le nombre de lon n est pas egal a nbp_lon'
     121         STOP
     122      ENDIF
     123    ENDIF
     124   
     125   
    118126    CALL nf95_inq_varid(ncid_in, "TIME", varid)
    119127    CALL nf95_gw_var(ncid_in, varid, time)
    … …  
    144152!---reduce to a klon_glo grid
    145153    CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo)
    146 
     154   
     155    ELSE
     156      ALLOCATE(tauaerstrat_mois(0,0,0))
    147157    ENDIF !--is_mpi_root and is_omp_root
    148158
    … …  
    153163
    154164!--scatter on all proc
    155     CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
    156 
     165   
     166    IF (grid_type==unstructured) THEN
     167      IF (is_omp_master) THEN
     168        ALLOCATE(tauaerstrat_mpi(klon_mpi,klev))
     169        CALL xios_send_field("taustrat_in",tauaerstrat_mois)
     170        CALL xios_recv_field("taustrat_out",tauaerstrat_mpi)
     171      ELSE
     172        ALLOCATE(tauaerstrat_mpi(0,0))
     173      ENDIF
     174      CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
     175    ELSE 
     176      CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
     177    ENDIF
     178   
    157179    IF (is_mpi_root.AND.is_omp_root) THEN
    158180!

  • LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90

    r2744 r3435  
    22! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
    33!
     4
    45SUBROUTINE readaerosolstrato2_rrtm(debut)
    56
    … …  
    910
    1011    USE phys_cal_mod, ONLY : mth_cur
    11     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo
    12     USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    13     USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
     12    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
     13    USE mod_phys_lmdz_mpi_data
     14    USE mod_phys_lmdz_omp_data
    1415    USE mod_phys_lmdz_para
    1516    USE phys_state_var_mod
    … …  
    1920    USE YOERAD, ONLY : NLW
    2021    USE YOMCST
    21 
     22    USE xios
    2223    IMPLICIT NONE
    2324
    … …  
    6566    REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :)
    6667    REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :)
     68    REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :, :)
     69    REAL, ALLOCATABLE:: pizaerstrat_mpi(:, :, :)
     70    REAL, ALLOCATABLE:: cgaerstrat_mpi(:, :, :)
     71    REAL, ALLOCATABLE:: taulwaerstrat_mpi(:, :, :)
    6772
    6873! For NetCDF:
    … …  
    107112        CALL nf95_gw_var(ncid_in, varid, latitude)
    108113        n_lat = size(latitude)
    109         IF (n_lat.NE.nbp_lat) THEN
    110            print *, 'latitude=', n_lat, nbp_lat
    111            abort_message='Le nombre de lat n est pas egal a nbp_lat'
    112            CALL abort_physic(modname,abort_message,1)
     114
     115        IF (grid_type/=unstructured) THEN
     116           IF (n_lat.NE.nbp_lat) THEN
     117             print *, 'latitude=', n_lat, nbp_lat
     118             abort_message='Le nombre de lat n est pas egal a nbp_lat'
     119             CALL abort_physic(modname,abort_message,1)
     120           ENDIF
    113121        ENDIF
    114122
    … …  
    134142        ALLOCATE(cgaerstrat(n_lat, n_lev, n_wav, n_month))
    135143
    136         ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
    137         ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
    138         ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
    139 
    140         ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav))
    141         ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav))
    142         ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav))
    143 
    144144!--reading stratospheric aerosol tau per layer
    145145        CALL nf95_inq_varid(ncid_in, "TAU_SUN", varid)
    … …  
    159159        CALL nf95_close(ncid_in)
    160160
     161       
     162        IF (grid_type/=unstructured) THEN
     163          ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
     164          ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
     165          ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
     166
     167          ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav))
     168          ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav))
     169          ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav))
    161170!--select the correct month
    162171!--and copy into 1st longitude
    163         tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur)
    164         pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur)
    165         cgaerstrat_mois(1,:,:,:)  = cgaerstrat(:,:,:,mth_cur)
     172          tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur)
     173          pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur)
     174          cgaerstrat_mois(1,:,:,:)  = cgaerstrat(:,:,:,mth_cur)
    166175
    167176!--copy longitudes
    168         DO i=2, n_lon
    169          tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:)
    170          pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:)
    171          cgaerstrat_mois(i,:,:,:)  = cgaerstrat_mois(1,:,:,:)
    172         ENDDO
     177          DO i=2, n_lon
     178           tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:)
     179           pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:)
     180           cgaerstrat_mois(i,:,:,:)  = cgaerstrat_mois(1,:,:,:)
     181          ENDDO
    173182
    174183!---reduce to a klon_glo grid
    175         DO band=1, NSW
    176           CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band))
    177           CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band))
    178           CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band))
    179         ENDDO
    180 
     184          DO band=1, NSW
     185            CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band))
     186            CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band))
     187            CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band))
     188          ENDDO
     189        ENDIF
    181190!--Now LW optical properties
    182191!
     192
    183193        CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in)
    184194
    … …  
    194204        CALL nf95_gw_var(ncid_in, varid, latitude)
    195205        n_lat = size(latitude)
    196         IF (n_lat.NE.nbp_lat) THEN
    197            abort_message='Le nombre de lat n est pas egal a nbp_lat'
    198            CALL abort_physic(modname,abort_message,1)
    199         ENDIF
    200 
     206
     207        IF (grid_type/=unstructured) THEN
     208          IF (n_lat.NE.nbp_lat) THEN
     209             abort_message='Le nombre de lat n est pas egal a nbp_lat'
     210             CALL abort_physic(modname,abort_message,1)
     211          ENDIF
     212        ENDIF
     213       
    201214        CALL nf95_inq_varid(ncid_in, "TIME", varid)
    202215        CALL nf95_gw_var(ncid_in, varid, time)
    … …  
    217230
    218231        ALLOCATE(taulwaerstrat(n_lat, n_lev, n_wav, n_month))
    219         ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
    220         ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav))
    221232
    222233!--reading stratospheric aerosol lw tau per layer
    … …  
    227238        CALL nf95_close(ncid_in)
    228239
     240        IF (grid_type/=unstructured) THEN
     241
     242          ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
     243          ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav))
     244
    229245!--select the correct month
    230246!--and copy into 1st longitude
    231         taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur)
     247          taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur)
    232248!--copy longitudes
    233         DO i=2, n_lon
    234           taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:)
    235         ENDDO
     249          DO i=2, n_lon
     250            taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:)
     251          ENDDO
    236252
    237253!---reduce to a klon_glo grid
    238         DO band=1, NLW
    239           CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band))
    240         ENDDO
    241 
     254          DO band=1, NLW
     255            CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band))
     256          ENDDO
     257        ENDIF
     258     
    242259      ELSE !--proc other than mpi_root and omp_root
    243260           !--dummy allocation needed for debug mode
    … …  
    248265        ALLOCATE(taulwaerstrat_mois_glo(1,1,1))
    249266
     267        ALLOCATE(tauaerstrat(0,0,0,12))
     268        ALLOCATE(pizaerstrat(0,0,0,12))
     269        ALLOCATE(cgaerstrat(0,0,0,12))
     270        ALLOCATE(taulwaerstrat(0,0,0,12))
     271
     272
    250273      ENDIF !--is_mpi_root and is_omp_root
    251274
    … …  
    255278      mth_pre=mth_cur
    256279
     280      IF (grid_type==unstructured) THEN
     281
     282        IF (is_omp_master) THEN
     283          ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW))
     284          ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW))
     285          ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW))       
     286          ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW))
     287         
     288          CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8))
     289          CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi)
     290          CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8))
     291          CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi)
     292          CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8))
     293          CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi)
     294          CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8))
     295          CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi)
     296        ELSE
     297          ALLOCATE(tauaerstrat_mpi(0, 0, 0))
     298          ALLOCATE(pizaerstrat_mpi(0, 0, 0))
     299          ALLOCATE(cgaerstrat_mpi(0, 0, 0))       
     300          ALLOCATE(taulwaerstrat_mpi(0, 0, 0))
     301        ENDIF 
     302       
     303        CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
     304        CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat)
     305        CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat)
     306        CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat)
     307      ELSE 
     308       
    257309!--scatter on all proc
    258       CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
    259       CALL scatter(pizaerstrat_mois_glo,piz_aer_strat)
    260       CALL scatter(cgaerstrat_mois_glo,cg_aer_strat)
    261       CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat)
     310        CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
     311        CALL scatter(pizaerstrat_mois_glo,piz_aer_strat)
     312        CALL scatter(cgaerstrat_mois_glo,cg_aer_strat)
     313        CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat)
     314
     315      ENDIF
    262316
    263317      IF (is_mpi_root.AND.is_omp_root) THEN
    264 !
    265         DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat)
    266318        DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois)
    267         DEALLOCATE(taulwaerstrat,taulwaerstrat_mois)
    268 !
    269       ENDIF !--is_mpi_root and is_omp_root
    270 
    271       DEALLOCATE(tauaerstrat_mois_glo,pizaerstrat_mois_glo,cgaerstrat_mois_glo)
    272       DEALLOCATE(taulwaerstrat_mois_glo)
     319        DEALLOCATE(taulwaerstrat_mois)
     320        DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat)
     321      ENDIF
     322     
    273323
    274324!$OMP BARRIER

  • LMDZ6/trunk/libf/phylmd/rrtm/suinit.F90

    r1990 r3435  
    126126ALLOCATE(VDELA  (MAX(JPMXLE,NFLEVG)))
    127127ALLOCATE(VDELB  (MAX(JPMXLE,NFLEVG)))
     128VDELB = 0  !ym missing init
    128129ALLOCATE( VC      (NFLEVG) )
     130VC = 0    !ym missing init
    129131ALLOCATE( NLOEN   (NPROMA) )
    130132ALLOCATE( NLOENG   (NPROMA) )

  • LMDZ6/trunk/libf/phylmd/slab_heat_transp_mod.F90

    r3002 r3435  
    8383                                  cu_,cuvsurcv_,cv_,cvusurcu_, &
    8484                                  aire_,apoln_,apols_, &
    85                                   aireu_,airev_,rlatv)
    86     USE comconst_mod, ONLY: omeg, rad
     85                                  aireu_,airev_,rlatv, rad, omeg)
    8786    ! number of points in lon, lat
    8887    IMPLICIT NONE
    … …  
    104103    REAL,INTENT(IN) :: airev_(ip1jm)
    105104    REAL,INTENT(IN) :: rlatv(nbp_lat-1)
     105    REAL,INTENT(IN) :: rad
     106    REAL,INTENT(IN) :: omeg
    106107
    107108    ! Sanity check on dimensions

  • LMDZ6/trunk/libf/phylmd/surf_land_mod.F90

    r3391 r3435  
    4141    USE surf_land_orchidee_nofrein_mod
    4242#else
     43#if ORCHIDEE_NOUNSTRUCT
     44    ! Compilation with cpp key ORCHIDEE_NOUNSTRUCT
     45    USE surf_land_orchidee_nounstruct_mod
     46#else
    4347    USE surf_land_orchidee_mod
     48#endif
    4449#endif
    4550#endif

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

    r3391 r3435  
    44#ifndef ORCHIDEE_NOZ0H
    55#ifndef ORCHIDEE_NOFREIN
     6#ifndef ORCHIDEE_NOUNSTRUCT
    67!
    78! This module controles the interface towards the model ORCHIDEE.
    … …  
    2324  USE cpl_mod,      ONLY : cpl_send_land_fields
    2425  USE surface_data, ONLY : type_ocean
    25   USE geometry_mod, ONLY : dx, dy
     26  USE geometry_mod, ONLY : dx, dy, boundslon, boundslat,longitude, latitude, cell_area,  ind_cell_glo
    2627  USE mod_grid_phy_lmdz
    2728  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
    2829  USE carbon_cycle_mod, ONLY : nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out
    29 
     30  USE nrtype, ONLY : PI
     31 
    3032  IMPLICIT NONE
    3133
    … …  
    165167    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: lalo
    166168    !$OMP THREADPRIVATE(lalo)
     169! boundaries of cells
     170    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: bounds_lalo
     171    !$OMP THREADPRIVATE(bounds_lalo)
    167172! pts voisins
    168173    INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
    … …  
    178183    !$OMP THREADPRIVATE(lon_scat,lat_scat)
    179184
     185! area of cells
     186    REAL, ALLOCATABLE, DIMENSION (:), SAVE  :: area 
     187    !$OMP THREADPRIVATE(area)
     188
    180189    LOGICAL, SAVE                             :: lrestart_read = .TRUE.
    181190    !$OMP THREADPRIVATE(lrestart_read)
    … …  
    209218    !$OMP THREADPRIVATE(riverflow)
    210219   
     220    INTEGER :: orch_mpi_rank
     221    INTEGER :: orch_mpi_size
    211222    INTEGER :: orch_omp_rank
    212223    INTEGER :: orch_omp_size
     224
     225    REAL, ALLOCATABLE, DIMENSION(:)         :: longitude_glo
     226    REAL, ALLOCATABLE, DIMENSION(:)         :: latitude_glo
     227    REAL, ALLOCATABLE, DIMENSION(:,:)       :: boundslon_glo
     228    REAL, ALLOCATABLE, DIMENSION(:,:)       :: boundslat_glo
     229    INTEGER, ALLOCATABLE, DIMENSION(:)      :: ind_cell_glo_glo
     230    INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell
     231    !$OMP THREADPRIVATE(ind_cell)
     232    INTEGER :: begin, end
    213233!
    214234! Fin definition
    … …  
    253273       jg(klon) = nbp_lat
    254274
    255        IF ((.NOT. ALLOCATED(lalo))) THEN
    256           ALLOCATE(lalo(knon,2), stat = error)
     275       IF ((.NOT. ALLOCATED(area))) THEN
     276          ALLOCATE(area(knon), stat = error)
    257277          IF (error /= 0) THEN
     278             abort_message='Pb allocation area'
     279             CALL abort_physic(modname,abort_message,1)
     280          ENDIF
     281       ENDIF
     282       DO igrid = 1, knon
     283          area(igrid) = cell_area(knindex(igrid))
     284       ENDDO
     285       
     286       IF (grid_type==unstructured) THEN
     287
     288
     289         IF ((.NOT. ALLOCATED(lon_scat))) THEN
     290            ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
     291            IF (error /= 0) THEN
     292               abort_message='Pb allocation lon_scat'
     293               CALL abort_physic(modname,abort_message,1)
     294            ENDIF
     295         ENDIF
     296 
     297         IF ((.NOT. ALLOCATED(lat_scat))) THEN
     298            ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
     299            IF (error /= 0) THEN
     300               abort_message='Pb allocation lat_scat'
     301               CALL abort_physic(modname,abort_message,1)
     302            ENDIF
     303         ENDIF
     304         CALL Gather(rlon,rlon_g)
     305         CALL Gather(rlat,rlat_g)
     306
     307         IF (is_mpi_root) THEN
     308            index = 1
     309            DO jj = 2, nbp_lat-1
     310               DO ij = 1, nbp_lon
     311                  index = index + 1
     312                  lon_scat(ij,jj) = rlon_g(index)
     313                  lat_scat(ij,jj) = rlat_g(index)
     314               ENDDO
     315            ENDDO
     316            lon_scat(:,1) = lon_scat(:,2)
     317            lat_scat(:,1) = rlat_g(1)
     318            lon_scat(:,nbp_lat) = lon_scat(:,2)
     319            lat_scat(:,nbp_lat) = rlat_g(klon_glo)
     320         ENDIF
     321     
     322         CALL bcast(lon_scat)
     323         CALL bcast(lat_scat)
     324               
     325       ELSE IF (grid_type==regular_lonlat) THEN
     326
     327         IF ((.NOT. ALLOCATED(lalo))) THEN
     328            ALLOCATE(lalo(knon,2), stat = error)
     329            IF (error /= 0) THEN
     330               abort_message='Pb allocation lalo'
     331               CALL abort_physic(modname,abort_message,1)
     332            ENDIF
     333         ENDIF
     334       
     335         IF ((.NOT. ALLOCATED(bounds_lalo))) THEN
     336           ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error)
     337           IF (error /= 0) THEN
    258338             abort_message='Pb allocation lalo'
    259339             CALL abort_physic(modname,abort_message,1)
    260           ENDIF
    261        ENDIF
    262        IF ((.NOT. ALLOCATED(lon_scat))) THEN
    263           ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
    264           IF (error /= 0) THEN
    265              abort_message='Pb allocation lon_scat'
    266              CALL abort_physic(modname,abort_message,1)
    267           ENDIF
    268        ENDIF
    269        IF ((.NOT. ALLOCATED(lat_scat))) THEN
    270           ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
    271           IF (error /= 0) THEN
    272              abort_message='Pb allocation lat_scat'
    273              CALL abort_physic(modname,abort_message,1)
    274           ENDIF
    275        ENDIF
    276        lon_scat = 0.
    277        lat_scat = 0.
    278        DO igrid = 1, knon
    279           index = knindex(igrid)
    280           lalo(igrid,2) = rlon(index)
    281           lalo(igrid,1) = rlat(index)
    282        ENDDO
    283 
    284        
    285        
    286        CALL Gather(rlon,rlon_g)
    287        CALL Gather(rlat,rlat_g)
    288 
    289        IF (is_mpi_root) THEN
    290           index = 1
    291           DO jj = 2, nbp_lat-1
    292              DO ij = 1, nbp_lon
    293                 index = index + 1
    294                 lon_scat(ij,jj) = rlon_g(index)
    295                 lat_scat(ij,jj) = rlat_g(index)
    296              ENDDO
    297           ENDDO
    298           lon_scat(:,1) = lon_scat(:,2)
    299           lat_scat(:,1) = rlat_g(1)
    300           lon_scat(:,nbp_lat) = lon_scat(:,2)
    301           lat_scat(:,nbp_lat) = rlat_g(klon_glo)
    302        ENDIF
     340           ENDIF
     341         ENDIF
     342       
     343         IF ((.NOT. ALLOCATED(lon_scat))) THEN
     344            ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
     345            IF (error /= 0) THEN
     346               abort_message='Pb allocation lon_scat'
     347               CALL abort_physic(modname,abort_message,1)
     348            ENDIF
     349         ENDIF
     350         IF ((.NOT. ALLOCATED(lat_scat))) THEN
     351            ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
     352            IF (error /= 0) THEN
     353               abort_message='Pb allocation lat_scat'
     354               CALL abort_physic(modname,abort_message,1)
     355            ENDIF
     356         ENDIF
     357         lon_scat = 0.
     358         lat_scat = 0.
     359         DO igrid = 1, knon
     360            index = knindex(igrid)
     361            lalo(igrid,2) = rlon(index)
     362            lalo(igrid,1) = rlat(index)
     363            bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI
     364            bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI
     365         ENDDO
     366
     367       
     368       
     369         CALL Gather(rlon,rlon_g)
     370         CALL Gather(rlat,rlat_g)
     371
     372         IF (is_mpi_root) THEN
     373            index = 1
     374            DO jj = 2, nbp_lat-1
     375               DO ij = 1, nbp_lon
     376                  index = index + 1
     377                  lon_scat(ij,jj) = rlon_g(index)
     378                  lat_scat(ij,jj) = rlat_g(index)
     379               ENDDO
     380            ENDDO
     381            lon_scat(:,1) = lon_scat(:,2)
     382            lat_scat(:,1) = rlat_g(1)
     383            lon_scat(:,nbp_lat) = lon_scat(:,2)
     384            lat_scat(:,nbp_lat) = rlat_g(klon_glo)
     385         ENDIF
    303386   
    304        CALL bcast(lon_scat)
    305        CALL bcast(lat_scat)
     387         CALL bcast(lon_scat)
     388         CALL bcast(lat_scat)
     389       
     390       ENDIF
    306391!
    307392! Allouer et initialiser le tableau des voisins et des fraction de continents
    308393!
    309        IF ( (.NOT.ALLOCATED(neighbours))) THEN
    310           ALLOCATE(neighbours(knon,8), stat = error)
    311           IF (error /= 0) THEN
    312              abort_message='Pb allocation neighbours'
    313              CALL abort_physic(modname,abort_message,1)
    314           ENDIF
    315        ENDIF
    316        neighbours = -1.
    317394       IF (( .NOT. ALLOCATED(contfrac))) THEN
    318395          ALLOCATE(contfrac(knon), stat = error)
    … …  
    329406
    330407
    331        CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
     408       IF (grid_type==regular_lonlat) THEN
     409 
     410         IF ( (.NOT.ALLOCATED(neighbours))) THEN
     411          ALLOCATE(neighbours(knon,8), stat = error)
     412          IF (error /= 0) THEN
     413             abort_message='Pb allocation neighbours'
     414             CALL abort_physic(modname,abort_message,1)
     415          ENDIF
     416         ENDIF
     417         neighbours = -1.
     418         CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
     419
     420       ELSE IF (grid_type==unstructured) THEN
     421 
     422         IF ( (.NOT.ALLOCATED(neighbours))) THEN
     423          ALLOCATE(neighbours(knon,12), stat = error)
     424          IF (error /= 0) THEN
     425             abort_message='Pb allocation neighbours'
     426             CALL abort_physic(modname,abort_message,1)
     427          ENDIF
     428         ENDIF
     429         neighbours = -1.
     430 
     431       ENDIF
     432         
    332433
    333434!
    … …  
    340441          ENDIF
    341442       ENDIF
    342        DO igrid = 1, knon
    343           ij = knindex(igrid)
    344           resolution(igrid,1) = dx(ij)
    345           resolution(igrid,2) = dy(ij)
    346        ENDDO
    347      
     443       
     444       IF (grid_type==regular_lonlat) THEN
     445         DO igrid = 1, knon
     446            ij = knindex(igrid)
     447            resolution(igrid,1) = dx(ij)
     448           resolution(igrid,2) = dy(ij)
     449         ENDDO
     450       ENDIF
     451       
    348452       ALLOCATE(coastalflow(klon), stat = error)
    349453       IF (error /= 0) THEN
    … …  
    397501    IF (debut) THEN
    398502       CALL Init_orchidee_index(knon,knindex,offset,ktindex)
    399        CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
     503       CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank)
     504
     505       IF (grid_type==unstructured) THEN
     506         IF (knon==0) THEN
     507           begin=1
     508           end=0
     509         ELSE
     510           begin=offset+1
     511           end=offset+ktindex(knon)
     512         ENDIF
     513       
     514         IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat
     515         
     516         ALLOCATE(lalo(end-begin+1,2))
     517         ALLOCATE(bounds_lalo(end-begin+1,nvertex,2))
     518         ALLOCATE(ind_cell(end-begin+1))
     519         
     520         ALLOCATE(longitude_glo(klon_glo))
     521         CALL gather(longitude,longitude_glo)
     522         CALL bcast(longitude_glo)
     523         lalo(:,2)=longitude_glo(begin:end)*180./PI
     524 
     525         ALLOCATE(latitude_glo(klon_glo))
     526         CALL gather(latitude,latitude_glo)
     527         CALL bcast(latitude_glo)
     528         lalo(:,1)=latitude_glo(begin:end)*180./PI
     529
     530         ALLOCATE(boundslon_glo(klon_glo,nvertex))
     531         CALL gather(boundslon,boundslon_glo)
     532         CALL bcast(boundslon_glo)
     533         bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI
     534 
     535         ALLOCATE(boundslat_glo(klon_glo,nvertex))
     536         CALL gather(boundslat,boundslat_glo)
     537         CALL bcast(boundslat_glo)
     538         bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI
     539         
     540         ALLOCATE(ind_cell_glo_glo(klon_glo))
     541         CALL gather(ind_cell_glo,ind_cell_glo_glo)
     542         CALL bcast(ind_cell_glo_glo)
     543         ind_cell(:)=ind_cell_glo_glo(begin:end)
     544         
     545       ENDIF
    400546       CALL Init_synchro_omp
    401547       
    402548       IF (knon > 0) THEN
    403549#ifdef CPP_VEGET
    404          CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
     550         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm,grid=grid_type)
    405551#endif
    406552       ENDIF
    407553
    408554       
    409        IF (knon > 0) THEN
     555       IF (knon > 0) THEN 
    410556
    411557         print *,'OB before intersurf=', SIZE(cfname_in), SIZE(cfname_out)
    412558#ifdef CPP_VEGET
     559
    413560         CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
    414561               lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, &
    … …  
    418565               evap, fluxsens, fluxlat, coastalflow, riverflow, &
    419566               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &   
    420 ! >> PC
    421                !lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch)
    422                lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch, &
     567               lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon), nvm_orch, &
     568               grid=grid_type, bounds_latlon=bounds_lalo, cell_area=area, ind_cell_glo=ind_cell, &
    423569               field_out_names=cfname_out, field_in_names=cfname_in(1:nbcf_in_orc))
    424 ! << PC
    425570#endif         
    426571       ENDIF
    … …  
    450595            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
    451596            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), &
    452             lon_scat, lat_scat, q2m, t2m, z0h_new(1:knon),&
     597            lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon),&
    453598            veget(1:knon,:),lai(1:knon,:),height(1:knon,:),&
    454599            fields_out=yfields_out(1:knon,1:nbcf_out),  &
    … …  
    542687!
    543688
    544   SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
     689  SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank)
    545690  USE  mod_surf_para
    546691     
    … …  
    550695
    551696    INTEGER,INTENT(OUT) :: orch_comm
     697    INTEGER,INTENT(OUT) :: orch_mpi_size
     698    INTEGER,INTENT(OUT) :: orch_mpi_rank
    552699    INTEGER,INTENT(OUT) :: orch_omp_size
    553700    INTEGER,INTENT(OUT) :: orch_omp_rank
    … …  
    568715#ifdef CPP_MPI   
    569716      CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
     717      CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr)
     718      CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr)
    570719#endif
    571720   
    … …  
    696845#endif
    697846#endif
     847#endif
    698848END MODULE surf_land_orchidee_mod

  • LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90

    r3421 r3435  
    1010
    1111    USE dimphy
    12     USE infotrac
     12    USE infotrac_phy
    1313    USE geometry_mod, ONLY : cell_area
    1414    USE carbon_cycle_mod, ONLY : nbcf_in, fields_in, cfname_in, fco2_ocn_day, fco2_ff, fco2_bb
    … …  
    119119
    120120    USE dimphy
    121     USE infotrac
     121    USE infotrac_phy
    122122    USE geometry_mod, ONLY : cell_area
    123123    USE mod_grid_phy_lmdz

  • LMDZ6/trunk/libf/phylmd/undefSTD.F90

    r2346 r3435  
    4343  ! PARAMETER(klevSTD=17)
    4444  INTEGER itap
    45   ! REAL dtime
    4645
    4746  ! variables locales
    … …  
    6766
    6867
    69     ! calcul variables tous les freq_calNMC(n)/dtime pas de temps
     68    ! calcul variables tous les freq_calNMC(n)/phys_tstep pas de temps
    7069    ! de la physique
    7170
    72     IF (mod(itap,nint(freq_calnmc(n)/dtime))==0) THEN
     71    IF (mod(itap,nint(freq_calnmc(n)/phys_tstep))==0) THEN
    7372      DO k = 1, nlevstd
    7473        DO i = 1, klon
    … …  
    103102      END DO !k
    104103
    105     END IF !MOD(itap,NINT(freq_calNMC(n)/dtime)).EQ.0
     104    END IF !MOD(itap,NINT(freq_calNMC(n)/phys_tstep)).EQ.0
    106105
    107106  END DO !n

  • LMDZ6/trunk/libf/phylmd/write_histrac.h

    r2265 r3435  
    88     
    99     CALL histwrite_phy(nid_tra,.FALSE.,"phis",itau_w,pphis)
    10      CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,airephy)
     10     CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,cell_area)
    1111     CALL histwrite_phy(nid_tra,.FALSE.,"zmasse",itau_w,zmasse)
    1212! RomP >>>

  • LMDZ6/trunk/libf/phylmd/yamada4.F90

    r3041 r3435  
    734734  IMPLICIT NONE
    735735 
    736   include "dimensions.h"
    737 
    738736!    vdif_q2: subroutine qui calcule la diffusion de la TKE par la TKE
    739737!             avec un schema implicite en temps avec
    … …  
    825823  IMPLICIT NONE
    826824
    827   include "dimensions.h"
    828 !
    829825! vdif_q2e: subroutine qui calcule la diffusion de TKE par la TKE
    830826!           avec un schema explicite en temps
Note: See TracChangeset for help on using the changeset viewer.