Ignore:
Timestamp:
Jan 22, 2019, 4:21:59 PM (5 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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.