Ignore:
Timestamp:
Mar 31, 2017, 11:31:38 AM (8 years ago)
Author:
emillour
Message:

All GCMs: set things up to enable pluging physics with dynamico

  • dyn3d
  • gcm.F90 : move I/O initialization (dates) to be done before physics

initialization

  • dyn3dpar
  • gcm.F : move I/O initialization (dates) to be done before physics

initialization

  • dynphy_lonlat:
  • inigeomphy_mod.F90 : add ind_cell_glo computation and transfer

to init_geometry

  • phy_common:
  • geometry_mod.F90 : add ind_cell_glo module variable to store global

column index

  • print_control_mod.F90 : make initialization occur via init_print_control_mod

to avoid circular module dependencies

  • init_print_control_mod.F90 : added to initialize print_control_mod module

variables

  • mod_phys_lmdz_mpi_data.F90 : use print_control_mod (rather than iniprint.h)
  • mod_phys_lmdz_para.F90 : use print_control_mod (rather than iniprint.h)
  • mod_phys_lmdz_omp_data.F90 : add is_omp_master (alias of is_omp_root) module

variable and use print_control_mod (rather than
iniprint.h)

  • physics_distribution_mod.F90 : add call to init_dimphy in

init_physics_distribution

  • xios_writefield.F90 : generic routine to output field with XIOS (for debug)
  • misc:
  • handle_err_m.F90 : call abort_physic, rather than abort_gcm
  • wxios.F90 : updates to enable unstructured grids

set module variable g_ctx_name to "LMDZ"
wxios_init(): remove call to wxios_context_init
wxios_context_init(): call xios_context_initialize with COMM_LMDZ_PHY
add routine wxios_set_context() to get handle and set context to XIOS
wxios_domain_param(): change arguments and generate the domain in-place
add wxios_domain_param_unstructured(): generate domain for unstructured case

NB: access is via "domain group" (whereas it is via "domain" in

wxios_domain_param)

  • dynphy_lonlat/phy[std|mars|venus|titan]:
  • iniphysiq_mod.F90 : Remove call to init_dimphy (which is now done in

phy_common/physics_distribution_mod.F90)

EM

Location:
trunk/LMDZ.GENERIC/libf/phystd
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • TabularUnified trunk/LMDZ.GENERIC/libf/phystd/inifis_mod.F90

    r1677 r1682  
    99             prad,pg,pr,pcpp)
    1010
     11  use init_print_control_mod, only: init_print_control
    1112  use radinc_h, only: ini_radinc_h, naerkind
    1213  use radcommon_h, only: ini_radcommon_h
     
    7677  REAL SSUM
    7778 
     79  ! Initialize flags lunout, prt_level, debug (in print_control_mod)
     80  CALL init_print_control
     81
    7882  ! initialize constants in comcstfi_mod
    7983  rad=prad
  • TabularUnified trunk/LMDZ.GENERIC/libf/phystd/ocean_slab_mod.F90

    r1397 r1682  
    9494      IF (error /= 0) THEN
    9595         abort_message='Pb allocation tmp_tslab'
    96          CALL abort_gcm(modname,abort_message,1)
     96         CALL abort_physic(modname,abort_message,1)
    9797      ENDIF
    9898      tmp_tslab(:,:) = tslab_rst(:,:)
     
    100100      IF (error /= 0) THEN
    101101         abort_message='Pb allocation tmp_tslab_loc'
    102          CALL abort_gcm(modname,abort_message,1)
     102         CALL abort_physic(modname,abort_message,1)
    103103      ENDIF
    104104      tmp_tslab_loc(:,:) = tslab_rst(:,:)
     
    107107    IF (error /= 0) THEN
    108108       abort_message='Pb allocation tmp_seaice'
    109        CALL abort_gcm(modname,abort_message,1)
     109       CALL abort_physic(modname,abort_message,1)
    110110    ENDIF
    111111    tmp_seaice(:) = seaice_rst(:)
     
    114114    IF (error /= 0) THEN
    115115       abort_message='Pb allocation tmp_pctsrf_slab'
    116        CALL abort_gcm(modname,abort_message,1)
     116       CALL abort_physic(modname,abort_message,1)
    117117    ENDIF
    118118    tmp_pctsrf_slab(:) = pctsrf_rst(:)
     
    122122    IF (error /= 0) THEN
    123123       abort_message='Pb allocation tmp_radsol'
    124        CALL abort_gcm(modname,abort_message,1)
     124       CALL abort_physic(modname,abort_message,1)
    125125    ENDIF
    126126
     
    128128    IF (error /= 0) THEN
    129129       abort_message='Pb allocation tmp_flux_o'
    130        CALL abort_gcm(modname,abort_message,1)
     130       CALL abort_physic(modname,abort_message,1)
    131131    ENDIF
    132132   
     
    134134    IF (error /= 0) THEN
    135135       abort_message='Pb allocation tmp_flux_g'
    136        CALL abort_gcm(modname,abort_message,1)
     136       CALL abort_physic(modname,abort_message,1)
    137137    ENDIF
    138138
     
    141141    IF (error /= 0) THEN
    142142       abort_message='Pb allocation slab_bils'
    143        CALL abort_gcm(modname,abort_message,1)
     143       CALL abort_physic(modname,abort_message,1)
    144144    ENDIF
    145145    slab_bils(:) = 0.0   
     
    148148    IF (error /= 0) THEN
    149149       abort_message='Pb allocation dt_hdiff'
    150        CALL abort_gcm(modname,abort_message,1)
     150       CALL abort_physic(modname,abort_message,1)
    151151    ENDIF
    152152    dt_hdiff = 0.0   
     
    155155    IF (error /= 0) THEN
    156156       abort_message='Pb allocation dt_hdiff'
    157        CALL abort_gcm(modname,abort_message,1)
     157       CALL abort_physic(modname,abort_message,1)
    158158    ENDIF
    159159    dt_ekman = 0.0   
     
    163163    IF (error /= 0) THEN
    164164       abort_message='Pb allocation lmt_bils'
    165        CALL abort_gcm(modname,abort_message,1)
     165       CALL abort_physic(modname,abort_message,1)
    166166    ENDIF
    167167    lmt_bils(:) = 0.0
     
    170170    IF (error /= 0) THEN
    171171       abort_message='Pb allocation slabh'
    172        CALL abort_gcm(modname,abort_message,1)
     172       CALL abort_physic(modname,abort_message,1)
    173173    ENDIF
    174174    slabh(1)=50.
  • TabularUnified trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90

    r1669 r1682  
    4848      use callkeys_mod
    4949      use vertical_layers_mod, only: presnivs, pseudoalt
     50      use mod_phys_lmdz_omp_data, ONLY: is_omp_master
    5051#ifdef CPP_XIOS     
    5152      use xios_output_mod, only: initialize_xios_output, &
    5253                                 update_xios_timestep, &
    5354                                 send_xios_field
     55      use wxios, only: wxios_context_init, xios_context_finalize
    5456#endif
    5557      implicit none
     
    529531         endif
    530532
     533#ifdef CPP_XIOS
     534        ! Initialize XIOS context
     535        write(*,*) "physiq: call wxios_context_init"
     536        CALL wxios_context_init
     537#endif
    531538
    532539!        Read 'startfi.nc' file.
     
    735742                                     presnivs,pseudoalt)
    736743#endif
     744         write(*,*) "physiq: end of firstcall"
    737745      endif ! end of 'firstcall'
    738746
     
    18931901         end if
    18941902
    1895          
    1896       endif ! end of 'lastcall'
     1903    endif ! end of 'lastcall'
    18971904
    18981905
     
    21812188      CALL send_xios_field("u",zu)
    21822189      CALL send_xios_field("v",zv)
    2183      
     2190
     2191      if (lastcall.and.is_omp_master) then
     2192        write(*,*) "physiq: call xios_context_finalize"
     2193        call xios_context_finalize
     2194      endif
    21842195#endif
    21852196
  • TabularUnified trunk/LMDZ.GENERIC/libf/phystd/xios_output_mod.F90

    r1626 r1682  
    2626                                mpi_size, mpi_rank, klon_mpi, &
    2727                                is_sequential, is_south_pole_dyn
    28   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
     28  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
    2929  USE print_control_mod, ONLY: lunout, prt_level
    3030  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
    3131  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
    3232  USE nrtype, ONLY: pi
    33   USE wxios
     33#ifdef CPP_XIOS
     34  USE xios
     35#endif
     36  USE wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_closedef
    3437  IMPLICIT NONE
    3538 
     
    6063    ! 2. Declare horizontal domain
    6164    ! Set values for the mask:
    62     IF (mpi_rank == 0) THEN
    63         data_ibegin = 0
    64     ELSE
    65         data_ibegin = ii_begin - 1
    66     END IF
    67 
    68     IF (mpi_rank == mpi_size-1) THEN
    69         data_iend = nbp_lon
    70     ELSE
    71         data_iend = ii_end + 1
    72     END IF
    73 
    74     if (prt_level>=10) then
    75       write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
    76       write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
    77       write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    78       write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    79       write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
    80     endif
    81 
     65!    IF (mpi_rank == 0) THEN
     66!        data_ibegin = 0
     67!    ELSE
     68!        data_ibegin = ii_begin - 1
     69!    END IF
     70
     71!    IF (mpi_rank == mpi_size-1) THEN
     72!        data_iend = nbp_lon
     73!    ELSE
     74!        data_iend = ii_end + 1
     75!    END IF
     76
     77!    if (prt_level>=10) then
     78!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
     79!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
     80!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     81!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     82!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
     83!    endif
     84
     85!$OMP END MASTER
     86!$OMP BARRIER
    8287    ! Initialize the XIOS domain coreesponding to this process:
    8388    if (prt_level>=10) write(lunout,*) "initialize_xios_output: call wxios_domain_param"
    84     CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
    85                             1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
    86                             klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
    87                             lat_reg*(180./pi), lon_reg*(180./pi),                       &
    88                             is_south_pole_dyn,mpi_rank)
    89 
     89!    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
     90!                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
     91!                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
     92!                            lat_reg*(180./pi), lon_reg*(180./pi),                       &
     93!                            is_south_pole_dyn,mpi_rank)
     94
     95    IF (grid_type==unstructured) THEN
     96      CALL wxios_domain_param_unstructured("dom_glo")
     97    ELSE
     98      CALL wxios_domain_param("dom_glo")
     99    ENDIF
     100
     101!$OMP MASTER
    90102    ! 3. Declare calendar and time step
    91103    if (prt_level>=10) write(lunout,*) "initialize_xios_output: build calendar"
Note: See TracChangeset for help on using the changeset viewer.