Ignore:
Timestamp:
Mar 14, 2019, 10:34:31 AM (5 years ago)
Author:
Laurent Fairhead
Message:

Further modifications for DYNAMICO/LMDZ convergence. These are based
on Yann's LMDZ6_V2 sources. Compiles on irene and converges with revision 3459
in a bucket configuration
YM/LF

Location:
LMDZ6/trunk/libf/phylmd
Files:
15 edited

Legend:

Unmodified
Added
Removed

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

    r2429 r3465  
    55  USE dimphy
    66  USE mod_phys_lmdz_para
     7  USE mod_grid_phy_lmdz, only: grid_type, unstructured, regular_lonlat
    78  IMPLICIT NONE
    89  INCLUDE 'YOMCST.h'
     10
     11  CHARACTER (len = 6)                :: clmodnam
     12  CHARACTER (len = 20)               :: modname = 'atm2geo'
     13  CHARACTER (len = 80)               :: abort_message
     14
    915!
    1016! Change wind local atmospheric coordinates to geocentric
    1117!
     18! Geocentric :
     19! axe x is eastward : crosses (0 N, 0 E) point.
     20! axe y crosses (0 N, 90 E) point.
     21! axe z is 'up' : crosses north pole
    1222  INTEGER, INTENT (in)                 :: im, jm
    13   REAL, DIMENSION (im,jm), INTENT (in) :: pte, ptn
     23  REAL, DIMENSION (im,jm), INTENT (in) :: pte  ! Eastward vector component
     24  REAL, DIMENSION (im,jm), INTENT (in) :: ptn  ! Northward vector component
    1425  REAL, DIMENSION (im,jm), INTENT (in) :: plon, plat
    15   REAL, DIMENSION (im,jm), INTENT(out) :: pxx, pyy, pzz
    16  
    17   REAL :: rad
    18 
     26  REAL, DIMENSION (im,jm), INTENT(out) :: pxx, pyy, pzz  ! Component in the geocentric referential
     27  REAL :: rad, reps
    1928
    2029  rad = rpi / 180.0E0
     30  reps = 1.0e-5
    2131 
    2232  pxx(:,:) = &
    … …  
    3141       + ptn(:,:) * COS(rad * plat (:,:))
    3242 
    33 ! Value at North Pole 
    34   IF (is_north_pole_dyn) THEN
    35      pxx(:, 1) = - pte (1, 1)
    36      pyy(:, 1) = - ptn (1, 1)
    37      pzz(:, 1) = pzz(1,1)
    38   ENDIF
     43  IF (grid_type==regular_lonlat) THEN
     44  ! Value at North Pole 
     45    IF (is_north_pole_dyn) THEN
     46       pxx(:, 1) = - pte (1, 1)
     47       pyy(:, 1) = - ptn (1, 1)
     48       pzz(:, 1) = pzz(1,1) ! => 0
     49    ENDIF
    3950
    40 ! Value at South Pole
    41   IF (is_south_pole_dyn) THEN
    42      pxx(:,jm) = pxx(1,jm)
    43      pyy(:,jm) = pyy(1,jm)
    44      pzz(:,jm) = pzz(1,jm)
    45   ENDIF
     51  ! Value at South Pole
     52    IF (is_south_pole_dyn) THEN
     53      pxx(:,jm) = pxx(1,jm)
     54       pyy(:,jm) = pyy(1,jm)
     55       pzz(:,jm) = pzz(1,jm) ! => 0
     56    ENDIF
     57 
     58  ELSE IF (grid_type==unstructured) THEN
     59     ! Pole nord pour Dynamico
     60     WHERE ( plat(:,:) >= 90.0d+0-reps )
     61        pxx (:,:) = -ptn (:,:)
     62        pyy (:,:) =  pte (:,:)
     63        pzz (:,:) =  0.0e0
     64     END WHERE
     65
     66  ELSE
     67     abort_message='Problem: unknown grid type'
     68     CALL abort_physic(modname,abort_message,1)
     69  END IF
     70
    4671 
    4772END SUBROUTINE atm2geo

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

    r3448 r3465  
    9797  !$OMP THREADPRIVATE(cpl_atm_co22D)
    9898
     99!!!!!!!!!! variable for calving
     100  INTEGER, PARAMETER :: nb_zone_calving = 3
     101  REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving
     102  !$OMP THREADPRIVATE(area_calving)
     103  REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D
     104  !$OMP THREADPRIVATE(cell_area2D)
     105  INTEGER, SAVE :: ind_calving(nb_zone_calving)
     106  !$OMP THREADPRIVATE(ind_calving)
     107
     108  LOGICAL,SAVE :: cpl_old_calving
     109  !$OMP THREADPRIVATE(cpl_old_calving)
     110 
    99111CONTAINS
    100112!
    … …  
    105117    USE surface_data
    106118    USE indice_sol_mod
    107     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo
     119    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, klon_glo, grid_type, unstructured, regular_lonlat
    108120    USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
    109121    USE print_control_mod, ONLY: lunout
     122    USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
     123    USE ioipsl_getin_p_mod, ONLY: getin_p
    110124
    111125! Input arguments
    … …  
    127141    CHARACTER(len = 80)               :: abort_message
    128142    CHARACTER(len=80)                 :: clintocplnam, clfromcplnam
     143    REAL, DIMENSION(klon_mpi)         :: rlon_mpi, rlat_mpi, cell_area_mpi
     144    INTEGER, DIMENSION(klon_mpi)           :: ind_cell_glo_mpi
     145    REAL, DIMENSION(nbp_lon,jj_nb)         :: lon2D, lat2D
     146    INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving)
     147    REAL :: pos
     148
     149!***************************************
     150! Use old calving or not (default no)
     151    cpl_old_calving=.FALSE.
     152    CALL getin_p("cpl_old_calving",cpl_old_calving)
     153
    129154
    130155!*************************************************************************************
    … …  
    208233    ENDIF
    209234
     235! calving initialization
     236    ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error)
     237    sum_error = sum_error + error
     238    ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)   
     239    sum_error = sum_error + error
     240
     241
     242    CALL gather_omp(longitude_deg,rlon_mpi)
     243    CALL gather_omp(latitude_deg,rlat_mpi)
     244    CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
     245    CALL gather_omp(cell_area,cell_area_mpi)
     246     
     247    IF (is_omp_master) THEN
     248      CALL Grid1DTo2D_mpi(rlon_mpi,lon2D)
     249      CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
     250      CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
     251      mask_calving(:,:,:) = 0
     252      WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
     253      WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1
     254      WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1
     255   
     256   
     257      DO i=1,nb_zone_calving
     258        area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:)
     259        pos=1
     260        IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1)
     261     
     262        ind_calving(i)=0
     263        IF (grid_type==unstructured) THEN
     264
     265          DO ig=1,klon_mpi
     266            IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig
     267          ENDDO
     268
     269        ELSE IF (grid_type==regular_lonlat) THEN
     270          IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN
     271            ind_calving(i)=pos-(jj_begin-1)*nbp_lon
     272          ENDIF
     273        ENDIF
     274     
     275      ENDDO
     276    ENDIF
     277   
     278           
    210279    IF (sum_error /= 0) THEN
    211280       abort_message='Pb allocation variables couplees'
    … …  
    10861155! Local variables
    10871156!*************************************************************************************
    1088     INTEGER                                              :: error, sum_error, j
     1157    INTEGER                                              :: error, sum_error, i,j,k
    10891158    INTEGER                                              :: itau_w
    10901159    INTEGER                                              :: time_sec
    … …  
    11031172! Table with all fields to send to coupler
    11041173    REAL, DIMENSION(nbp_lon, jj_nb, maxsend)                 :: tab_flds
    1105     REAL, DIMENSION(klon_mpi)                            :: rlon_mpi, rlat_mpi
    1106 
     1174    REAL, DIMENSION(klon_mpi)                                :: rlon_mpi, rlat_mpi
     1175    REAL  :: calving(nb_zone_calving)
     1176    REAL  :: calving_glo(nb_zone_calving)
     1177   
    11071178#ifdef CPP_MPI
    11081179    INCLUDE 'mpif.h'
    … …  
    11311202   
    11321203    IF (version_ocean=='nemo') THEN
    1133        tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
     1204       tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
    11341205       IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
    11351206    ELSE IF (version_ocean=='opa8') THEN
    … …  
    11581229!*************************************************************************************     
    11591230    IF (is_omp_root) THEN
     1231
     1232      IF (cpl_old_calving) THEN   ! use old calving
    11601233
    11611234      DO j = 1, jj_nb
    … …  
    11901263         ENDIF
    11911264      ENDIF
     1265      tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
     1266
     1267      ENDIF
     1268
     1269      DO k=1,nb_zone_calving
     1270        calving(k)=0
     1271        DO j = 1, jj_nb
     1272          calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic))
     1273        ENDDO
     1274      ENDDO
    11921275     
    1193       tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
     1276      CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
     1277     
     1278      tab_flds(:,:,ids_calvin) = 0
     1279      DO k=1,nb_zone_calving
     1280        IF (ind_calving(k)>0 ) THEN
     1281          j=(ind_calving(k)-1)/nbp_lon + 1
     1282          i=MOD(ind_calving(k)-1,nbp_lon)+1
     1283          tab_flds(i,j,ids_calvin) = calving_glo(k)
     1284        ENDIF
     1285      ENDDO
    11941286
    11951287!*************************************************************************************

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

    r3436 r3465  
    1616  USE ioipsl, ONLY : getin, ioget_year_len
    1717  USE time_phylmdz_mod, ONLY : annee_ref
     18  USE create_etat0_unstruct_mod
    1819  IMPLICIT NONE
    1920 
    … …  
    4344          ENDIF
    4445          IF (is_omp_master) CALL xios_set_file_attr("limit_write",enabled=.TRUE.)
     46          CALL init_create_etat0_unstruct
    4547        ENDIF
    4648     

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

    r3435 r3465  
    77
    88CONTAINS
    9 
     9 
     10  SUBROUTINE init_create_etat0_unstruct
     11  USE xios
     12  USE netcdf
     13  USE mod_phys_lmdz_para
     14  IMPLICIT NONE
     15  INTEGER :: file_id, iret
     16 
     17   ! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
     18    IF (is_omp_master) THEN
     19      IF(NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
     20        CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
     21        CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
     22        iret=NF90_CLOSE(file_id)
     23      ENDIF
     24    ENDIF
     25 
     26  END SUBROUTINE init_create_etat0_unstruct
     27 
     28 
    1029  SUBROUTINE create_etat0_unstruct
    1130  USE dimphy
    … …  
    1837  USE indice_sol_mod
    1938  USE mod_phys_lmdz_para
     39  USE print_control_mod, ONLY: lunout
     40  USE geometry_mod
     41  USE ioipsl_getin_p_mod, ONLY: getin_p
     42
    2043  IMPLICIT NONE
    2144  INCLUDE 'dimsoil.h'
    2245
     46    LOGICAL :: no_ter_antartique   ! If true, no land points are allowed at Antartic
    2347    REAL,    DIMENSION(klon)                 :: tsol
    2448    REAL,    DIMENSION(klon)                 :: sn
    … …  
    3357    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
    3458    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
     59    REAL,    DIMENSION(klon_mpi)             :: cell_area_mpi
     60    REAL,    DIMENSION(klon_mpi,nbsrf)       :: pctsrf_mpi
    3561
    3662    INTEGER :: ji,j,i
    … …  
    88114      END IF
    89115    END DO
     116
     117
     118  !--- Option no_ter_antartique removes all land fractions souther than 60S.
     119  !--- Land ice is set instead of the land fractions on these latitudes.
     120  !--- The ocean and sea-ice fractions are not changed.
     121  no_ter_antartique=.FALSE.
     122  CALL getin_p('no_ter_antartique',no_ter_antartique)
     123  WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
     124  IF (no_ter_antartique) THEN
     125     ! Remove all land fractions souther than 60S and set land-ice instead
     126     WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
     127     WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
     128     DO ji=1, klon
     129        IF (latitude_deg(ji)<-60.0) THEN
     130           pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
     131           pctsrf(ji,is_ter) = 0
     132        END IF
     133     END DO
     134  END IF
    90135   
    91136! sub-surface ocean and sea ice (sea ice set to zero for start)
    … …  
    182227    CALL fonte_neige_init(run_off_lic_0)
    183228    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
     229
     230    CALL gather_omp(cell_area,cell_area_mpi)
     231    CALL gather_omp(pctsrf,pctsrf_mpi)
     232    IF (is_omp_master) THEN
     233      CALL xios_send_field("area_ce0l",cell_area_mpi)
     234      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
     235      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
     236    ENDIF
     237   
    184238    CALL phyredem( "startphy.nc" )
    185239

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

    r2429 r3465  
    55  USE dimphy
    66  USE mod_phys_lmdz_para
    7 
     7  USE mod_grid_phy_lmdz, only: grid_type, unstructured, regular_lonlat
    88  IMPLICIT NONE
    99  INCLUDE 'YOMCST.h'
     10  CHARACTER (len = 6)                :: clmodnam
     11  CHARACTER (len = 20)               :: modname = 'geo2atm'
     12  CHARACTER (len = 80)               :: abort_message
    1013
    1114! Change wind coordinates from cartesian geocentric to local spherical
    1215! NB! Fonctionne probablement uniquement en MPI seul (sans OpenMP)
    1316!
     17! Geocentric :
     18  ! axe x is eastward : crosses (0N,90E) point.
     19  ! axe y  crosses (0N,180E) point.
     20  ! axe z is 'up' : crosses north pole.
     21!
     22! NB! Aux poles, fonctionne probablement uniquement en MPI seul (sans OpenMP)
     23
    1424  INTEGER, INTENT (IN)                 :: im, jm
    1525  REAL, DIMENSION (im,jm), INTENT(IN)  :: px, py, pz
    … …  
    1727  REAL, DIMENSION (im,jm), INTENT(OUT) :: pu, pv, pr
    1828
    19   REAL :: rad
     29  REAL :: rad,reps
    2030
    2131
    2232  rad = rpi / 180.0E0
    23  
     33  reps = 1.0e-5
     34
    2435  pu(:,:) = &
    2536       - px(:,:) * SIN(rad * plon(:,:)) &
    … …  
    3647       + pz(:,:) * SIN(rad * plat(:,:))
    3748
    38   ! Value at North Pole
    39   IF (is_north_pole_dyn) THEN
    40      pu(:, 1) = -px (1,1)
    41      pv(:, 1) = -py (1,1)
    42      pr(:, 1) = 0.0
    43   ENDIF
     49  IF (grid_type==regular_lonlat) THEN
     50    ! Value at North Pole
     51    IF (is_north_pole_dyn) THEN
     52       pu(:, 1) = -px (1,1)
     53       pv(:, 1) = -py (1,1)
     54       pr(:, 1) = 0.0
     55    ENDIF
    4456 
    45   ! Value at South Pole     
    46   IF (is_south_pole_dyn) THEN
    47      pu(:,jm) = -px (1,jm)
    48      pv(:,jm) = -py (1,jm)
    49      pr(:,jm) = 0.0
    50   ENDIF
     57    ! Value at South Pole     
     58    IF (is_south_pole_dyn) THEN
     59       pu(:,jm) = -px (1,jm)
     60       pv(:,jm) = -py (1,jm)
     61       pr(:,jm) = 0.0
     62    ENDIF
     63
     64  ELSE IF (grid_type==unstructured) THEN
     65     ! Pole nord pour Dynamico
     66     WHERE ( plat(:,:) >= 90.0-reps )
     67        pu(:,:) =  py(:,:)
     68        pv(:,:) = -px(:,:)
     69        pr(:,:) = 0.0e0
     70     END WHERE
     71
     72  ELSE
     73     abort_message='Problem: unknown grid type'
     74     CALL abort_physic(modname,abort_message,1)
     75  END IF
     76
     77 
     78 
    5179 
    5280END SUBROUTINE geo2atm

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

    r3457 r3465  
    4949  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
    5050  USE print_control_mod, ONLY: prt_level,lunout
    51   USE surface_data,     ONLY : type_ocean
    5251#ifdef CPP_IOIPSL
    5352    USE ioipsl, ONLY: flio_dom_set
    … …  
    7473
    7574#ifdef CPP_XIOS
    76     IF ( type_ocean /= 'couple' ) THEN
    7775      CALL wxios_context_init
    78     ENDIF
    7976#endif
    8077   

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

    r3435 r3465  
    126126    LOGICAL,OPTIONAL :: found
    127127   
    128     REAL    :: field_glo(klon_glo,field_size)
    129     REAL    :: field_glo_tmp(klon_glo,field_size)
    130     INTEGER :: ind_cell_glo_glo(klon_glo)
     128    REAL,ALLOCATABLE    :: field_glo(:,:)
     129    REAL,ALLOCATABLE    :: field_glo_tmp(:,:)
     130    INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:)
    131131    LOGICAL :: tmp_found
    132132    INTEGER :: varid
    133133    INTEGER :: ierr,i
    134134
    135 !    IF (is_master) ALLOCATE(ind_cell_glo_glo(1:klon_glo))
     135    IF (is_master) THEN
     136      ALLOCATE(ind_cell_glo_glo(klon_glo))
     137      ALLOCATE(field_glo(klon_glo,field_size))
     138      ALLOCATE(field_glo_tmp(klon_glo,field_size))
     139    ELSE
     140      ALLOCATE(ind_cell_glo_glo(0))
     141      ALLOCATE(field_glo(0,0))
     142    ENDIF
     143   
    136144    CALL gather(ind_cell_glo,ind_cell_glo_glo)
    137145   

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

    r3102 r3465  
    104104#ifdef CPP_XIOS
    105105    USE wxios, ONLY : wxios_context_init
     106    USE xios 
    106107#endif
    107108    USE print_control_mod, ONLY: lunout
    108     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
     109    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
     110    USE geometry_mod, ONLY: ind_cell_glo                   
     111    USE mod_phys_lmdz_mpi_data, ONLY: klon_mpi_para_nb
     112   
     113
    109114
    110115! Local variables
    … …  
    113118    INTEGER                            :: ierror, il_commlocal
    114119    INTEGER                            :: il_part_id
    115     INTEGER, DIMENSION(3)              :: ig_paral
     120    INTEGER, ALLOCATABLE               :: ig_paral(:)
    116121    INTEGER, DIMENSION(2)              :: il_var_nodims
    117122    INTEGER, DIMENSION(4)              :: il_var_actual_shape
    … …  
    136141! Define the model name
    137142!
    138     clmodnam = 'LMDZ'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     143    IF (grid_type==unstructured) THEN
     144        clmodnam = 'icosa'                 ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     145    ELSE IF (grid_type==regular_lonlat) THEN
     146        clmodnam = 'LMDZ'                  ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     147    ELSE
     148        abort_message='Pb : type of grid unknown'
     149        CALL abort_physic(modname,abort_message,1)
     150    ENDIF
    139151
    140152
    … …  
    236248! Domain decomposition
    237249!************************************************************************************
    238     ig_paral(1) = 1                            ! apple partition for //
    239     ig_paral(2) = (jj_begin-1)*nbp_lon+ii_begin-1  ! offset
    240     ig_paral(3) = (jj_end*nbp_lon+ii_end) - (jj_begin*nbp_lon+ii_begin) + 1
    241 
    242     IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+nbp_lon-1
     250    IF (grid_type==unstructured) THEN
     251
     252      ALLOCATE( ig_paral(klon_mpi_para_nb(mpi_rank) + 2) )
     253
     254      ig_paral(1) = 4                                      ! points partition for //
     255      ig_paral(2) = klon_mpi_para_nb(mpi_rank)             ! nb of local cells
     256
     257      DO jf=1, klon_mpi_para_nb(mpi_rank)
     258        ig_paral(2+jf) = ind_cell_glo(jf)
     259      ENDDO
     260
     261    ELSE IF (grid_type==regular_lonlat) THEN
     262
     263      ALLOCATE( ig_paral(3) )
     264
     265      ig_paral(1) = 1                            ! apple partition for //
     266      ig_paral(2) = (jj_begin-1)*nbp_lon+ii_begin-1  ! offset
     267      ig_paral(3) = (jj_end*nbp_lon+ii_end) - (jj_begin*nbp_lon+ii_begin) + 1
     268
     269      IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+nbp_lon-1
     270    ELSE
     271      abort_message='Pb : type of grid unknown'
     272      CALL abort_physic(modname,abort_message,1)
     273    ENDIF
     274
     275
    243276    WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
    244277   
    … …  
    253286    ENDIF
    254287
    255     il_var_nodims(1) = 2
    256     il_var_nodims(2) = 1
    257 
    258     il_var_actual_shape(1) = 1
    259     il_var_actual_shape(2) = nbp_lon
    260     il_var_actual_shape(3) = 1
    261     il_var_actual_shape(4) = nbp_lat
     288    il_var_nodims(1) = 2                        ! rank of field array (1d or 2d)
     289    il_var_nodims(2) = 1                        ! always 1 in current oasis version" doc oasis3mct p18
     290
     291    il_var_actual_shape(1) = 1                  ! min of 1st dimension (always 1)
     292    il_var_actual_shape(2) = nbp_lon            ! max of 1st dimension
     293    il_var_actual_shape(3) = 1                  ! min of 2nd dimension (always 1)
     294    il_var_actual_shape(4) = nbp_lat            ! max of 2nd dimension
    262295   
    263296    il_var_type = PRISM_Real
    … …  
    302335! End definition
    303336!************************************************************************************
     337#ifdef CPP_XIOS
     338    CALL xios_oasis_enddef()
     339#endif
    304340    CALL prism_enddef_proto(ierror)
    305341    IF (ierror .NE. PRISM_Ok) THEN
    … …  
    311347
    312348#ifdef CPP_XIOS
    313     CALL wxios_context_init()
     349!    CALL wxios_context_init()
    314350#endif
    315351

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

    r3462 r3465  
    524524  ENDIF
    525525
    526 ! FH: Called outside phyetat0
    527526!  CALL init_iophy_new(latitude_deg, longitude_deg)
    528527

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

    r3462 r3465  
    243243#endif
    244244    USE indice_sol_mod
    245     USE phytrac_mod, ONLY : phytrac
     245    USE phytrac_mod, ONLY : phytrac_init, phytrac
    246246    USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
    247247
    … …  
    14881488       ENDIF
    14891489       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1490        IF (grid_type/=unstructured) CALL init_iophy_new(latitude_deg,longitude_deg)
     1490       CALL init_iophy_new(latitude_deg,longitude_deg)
    14911491
    14921492          !===================================================================
    … …  
    15811581       CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
    15821582
    1583        IF(read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
    1584        CALL create_etat0_limit_unstruct
    1585        CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
    1586        IF (grid_type==unstructured) CALL init_iophy_new(latitude_deg,longitude_deg)
    1587 
    1588 !jyg<
    1589        IF (klon_glo==1) THEN
    1590           IF (iflag_pbl > 1) THEN         
    1591               pbl_tke(:,:,is_ave) = 0.
    1592               DO nsrf=1,nbsrf
    1593                 DO k = 1,klev+1
    1594                      pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
    1595                          +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
    1596                 ENDDO
    1597               ENDDO
    1598           ELSE   ! (iflag_pbl > 1)
    1599               pbl_tke(:,:,:) = 0.
    1600           ENDIF  ! (iflag_pbl > 1)
    1601         ELSE
    1602           pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
    1603 !>jyg
    1604        ENDIF
    16051583#ifdef CPP_COSP
    1606 
    16071584      IF (ok_cosp) THEN
    1608          CALL phys_cosp(itap,phys_tstep,freq_cosp, &
     1585        CALL phys_cosp(itap,phys_tstep,freq_cosp, &
    16091586               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    16101587               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    … …  
    16201597      ENDIF
    16211598#endif
    1622 
    1623        !
    1624        ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1599       !
     1600       !
     1601!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    16251602       ! Nouvelle initialisation pour le rayonnement RRTM
    1626        ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1603       !
     1604!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    16271605
    16281606       CALL iniradia(klon,klev,paprs(1,1:klev+1))
    1629 
     1607       ! Initialisation des champs dans phytrac qui sont utilisés par phys_output_write
     1608       IF (iflag_phytrac == 1 ) THEN
     1609          CALL phytrac_init()
     1610        ENDIF
     1611
     1612       CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
     1613                              pplay, lmax_th, aerosol_couple,                 &
     1614                              ok_ade, ok_aie, ivap, iliq, isol, new_aod, ok_sync,&
     1615                              ptconv, read_climoz, clevSTD,                   &
     1616                              ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
     1617                              flag_aerosol, flag_aerosol_strat, ok_cdnc)
    16301618
    16311619#ifdef CPP_XIOS
    16321620       IF (is_omp_master) CALL xios_update_calendar(1)
    16331621#endif
    1634 
     1622       IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
     1623       CALL create_etat0_limit_unstruct
     1624       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
     1625
     1626!jyg<
     1627       IF (klon_glo==1) THEN
     1628          pbl_tke(:,:,is_ave) = 0.
     1629          DO nsrf=1,nbsrf
     1630            DO k = 1,klev+1
     1631                 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
     1632                     +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
     1633            ENDDO
     1634          ENDDO
     1635        ELSE
     1636          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
     1637!>jyg
     1638       ENDIF
    16351639       !IM begin
    16361640       print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
    … …  
    17781782       tave = 'ave(X)'
    17791783       !IM cf. AM 081204 BEG
     1784       write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
    17801785       !IM cf. AM 081204 END
    17811786       !
    … …  
    17831788       !   Initialisation des sorties
    17841789       !=============================================================
    1785 
    1786        CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
    1787                               pplay, lmax_th, aerosol_couple,                 &
    1788                               ok_ade, ok_aie, ivap, iliq, isol, new_aod, ok_sync,&
    1789                               ptconv, read_climoz, clevSTD,                   &
    1790                               ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
    1791                               flag_aerosol, flag_aerosol_strat, ok_cdnc)
    17921790
    17931791#ifdef CPP_XIOS
    … …  
    18741872#endif
    18751873       ENDIF
     1874
    18761875       !$omp single
    18771876       IF (read_climoz >= 1) CALL open_climoz(ncid_climoz, press_cen_climoz,   &

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

    r3450 r3465  
    5353
    5454CONTAINS
     55
     56  SUBROUTINE phytrac_init()
     57    USE dimphy
     58    USE infotrac_phy, ONLY: nbtr
     59    IMPLICIT NONE
     60
     61       ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
     62       ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
     63       ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
     64       ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
     65       ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
     66       ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
     67       ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
     68       ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
     69       ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
     70       ALLOCATE(d_tr_th(klon,klev,nbtr))
     71       ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
     72
     73  END SUBROUTINE phytrac_init
    5574
    5675  SUBROUTINE phytrac(                                 &

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

    r3435 r3465  
    403403  zsolsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
    404404  zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
    405  
     405
     406
     407   ZTOPSWADAERO(:)  = 0. !ym missing init
     408   ZSOLSWADAERO(:)  = 0. !ym missing init
     409   ZTOPSWAD0AERO(:) = 0. !ym missing init
     410   ZSOLSWAD0AERO(:) = 0. !ym missing init
     411   ZTOPSWAIAERO(:)  = 0. !ym missing init
     412   ZSOLSWAIAERO(:)  = 0. !ym missing init 
     413   ZTOPSWCF_AERO(:,:)= 0.!ym missing init 
     414   ZSOLSWCF_AERO(:,:) =0. !ym missing init 
     415
    406416  !
    407417  !-------------------------------------------

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

    r3436 r3465  
    218218      END DO
    219219
    220     !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west)
    221     dx1=locate(v1,boundslon_reg(1,west))-1
    222     v1=CSHIFT(v1,SHIFT=dx1,DIM=1); v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi
    223     !--- Extend input longitudes vector until last interval contains boundslon_reg(nlon_ou,east)
    224     dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
    225 
     220      !--- Prepare quantities for time interpolation
     221      tmidmonth=mid_month(annee_ref, cal_in)
     222      IF(interpt) THEN
     223        ntim_ou=ioget_year_len(annee_ref)
     224        ALLOCATE(tmidday(ntim_ou))
     225        tmidday=[(REAL(k)-0.5,k=1,ntim_ou)]
     226        CALL ioget_calendar(cal_ou)
     227      ELSE
     228        ntim_ou=14
     229        cal_ou=cal_in
     230      END IF
     231    ENDIF
     232
     233    IF (grid_type==unstructured) THEN
     234      CALL bcast_mpi(nlon_in)
     235      CALL bcast_mpi(nlat_in)
     236      CALL bcast_mpi(nlev_in)
     237      CALL bcast_mpi(l3d)
     238      CALL bcast_mpi(tmidmonth)
     239      CALL bcast_mpi(tmidday)
     240      CALL bcast_mpi(ntim_ou)
     241
     242#ifdef CPP_XIOS   
     243      IF (is_mpi_root) THEN
     244        CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=nlat_in, jbegin=0, latvalue_1d=lat_in/deg2rad)
     245        IF (l3D) THEN
     246          CALL xios_set_domain_attr("domain_climoz",ni_glo=nlon_in, ni=nlon_in, ibegin=0, lonvalue_1d=lon_in/deg2rad)
     247        ELSE
     248          CALL xios_set_domain_attr("domain_climoz",ni_glo=8, ni=8, ibegin=0, lonvalue_1d = (/ 0.,45.,90.,135.,180.,225.,270., 315. /))
     249        ENDIF
     250      ELSE
     251        CALL xios_set_domain_attr("domain_climoz",nj_glo=nlat_in, nj=0, jbegin=0, latvalue_1d=null_array )
     252        IF (l3D) THEN
     253          CALL xios_set_domain_attr("domain_climoz",ni_glo=nlon_in, ni=0, ibegin=0, lonvalue_1d=null_array)
     254        ELSE
     255          CALL xios_set_domain_attr("domain_climoz",ni_glo=8, ni=0, ibegin=0, lonvalue_1d=null_array)
     256        ENDIF
     257      ENDIF
     258      CALL  xios_set_axis_attr("axis_climoz", n_glo=nlev_in)
     259      CALL  xios_set_axis_attr("time_axis_climoz", n_glo=ntim_ou)
     260      CALL  xios_set_axis_attr("time_axis_climoz", n_glo=ntim_ou)
     261      CALL  xios_set_axis_attr("tr_climoz", n_glo=read_climoz)
     262      CALL  xios_set_field_attr("tro3_out", enabled=.TRUE.)
     263      CALL  xios_set_field_attr("tro3_out", enabled=.TRUE.)
     264#endif
     265     
    226266      IF (first) THEN
    227267        first=.FALSE.
    … …  
    254294          dx1=locate(v1,boundslon_reg(1,west))-1
    255295          v1=CSHIFT(v1,SHIFT=dx1,DIM=1)
    256           v1(nlon_in-dx1+1:)=v1(nlon_in-dx1+1:)+2.*pi
     296          v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi
    257297   
    258298          !--- Extend input longitudes vector until last interval contains boundslon_reg(nlat_ou,east)
    259           dx2=0; DO WHILE(v1(1+dx2)+2.*pi<boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
     299          dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
    260300
    261301          !--- Final edges longitudes vector (with margin and end point)

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

    r3438 r3465  
    318318        CALL scatter(cgaerstrat_mois_glo,cg_aer_strat)
    319319        CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat)
     320        IF (is_mpi_root.AND.is_omp_root)  DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois, taulwaerstrat_mois)
    320321
    321322      ENDIF
    322323
    323324      IF (is_mpi_root.AND.is_omp_root) THEN
    324         DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois)
    325         DEALLOCATE(taulwaerstrat_mois)
    326325        DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat)
    327326      ENDIF

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

    r3435 r3465  
    579579!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
    580580    swdown_vrai(1:knon) = swdown(1:knon)
     581!$OMP BARRIER
    581582
    582583    IF (knon > 0) THEN
Note: See TracChangeset for help on using the changeset viewer.