Changeset 3889


Ignore:
Timestamp:
May 5, 2021, 4:02:41 PM (4 years ago)
Author:
Sebastien Nguyen
Message:

modified cpl_mod.f90 inigeomphy_mod.F90 and geometry_mod.F90 to switch between old_calving and new_calving computations if MOSAIC or MOSAIX weigths are used for coupling

Location:
LMDZ5/branches/IPSLCM5A2.1/libf
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/IPSLCM5A2.1/libf/dynphy_lonlat/inigeomphy_mod.F90

    r2588 r3889  
    7373  REAL,ALLOCATABLE,SAVE :: boundslonfi(:,:)
    7474  REAL,ALLOCATABLE,SAVE :: boundslatfi(:,:)
    75 !$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi)
     75  INTEGER,ALLOCATABLE,SAVE :: ind_cell_glo_fi(:)
     76!$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi,ind_cell_glo_fi)
    7677
    7778  ! Initialize Physics distibution and parameters and interface with dynamics
    … …  
    201202  ALLOCATE(boundslonfi(klon_omp,4))
    202203  ALLOCATE(boundslatfi(klon_omp,4))
     204  ALLOCATE(ind_cell_glo_fi(klon_omp))
    203205
    204206
    … …  
    211213  boundslonfi(1:klon_omp,:) = boundslonfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:)
    212214  boundslatfi(1:klon_omp,:) = boundslatfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:)
     215  ind_cell_glo_fi(1:klon_omp)=(/ (i,i=offset+klon_omp_begin,offset+klon_omp_end) /)
    213216
    214217  ! copy over local grid longitudes and latitudes
    215218  CALL init_geometry(klon_omp,lonfi,latfi,boundslonfi,boundslatfi, &
    216                      airefi,cufi,cvfi)
     219                     airefi,ind_cell_glo_fi,cufi,cvfi)
    217220
    218221!$OMP END PARALLEL

  • LMDZ5/branches/IPSLCM5A2.1/libf/phy_common/geometry_mod.F90

    r2395 r3889  
    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_(:)

  • LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/cpl_mod.F90

    r2545 r3889  
    9393  !$OMP THREADPRIVATE(cpl_atm_co22D)
    9494
     95!!!!!!!!!! variable for calving
     96  INTEGER, PARAMETER :: nb_zone_calving = 3
     97  REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving
     98  !$OMP THREADPRIVATE(area_calving)
     99  REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D
     100  !$OMP THREADPRIVATE(cell_area2D)
     101  INTEGER, SAVE :: ind_calving(nb_zone_calving)
     102  !$OMP THREADPRIVATE(ind_calving)
     103  LOGICAL,SAVE :: cpl_old_calving
     104  !$OMP THREADPRIVATE(cpl_old_calving)
     105
    95106CONTAINS
    96107!
    … …  
    101112    USE surface_data
    102113    USE indice_sol_mod
    103     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     114    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, klon_glo, grid_type, unstructured, regular_lonlat
    104115    USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
    105116    USE print_control_mod, ONLY: lunout
     117    USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
     118    USE ioipsl_getin_p_mod, ONLY: getin_p
    106119
    107120! Input arguments
    … …  
    123136    CHARACTER(len = 80)               :: abort_message
    124137    CHARACTER(len=80)                 :: clintocplnam, clfromcplnam
    125 
     138    REAL, DIMENSION(klon_mpi)         :: rlon_mpi, rlat_mpi, cell_area_mpi
     139    INTEGER, DIMENSION(klon_mpi)           :: ind_cell_glo_mpi
     140    REAL, DIMENSION(nbp_lon,jj_nb)         :: lon2D, lat2D
     141    INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving)
     142    REAL :: pos
     143!***************************************
     144! Use old calving or not (default no)
     145    cpl_old_calving=.TRUE.
     146    CALL getin_p("cpl_old_calving",cpl_old_calving)
     147    print*,"cpl_old_calving = ",cpl_old_calving
    126148!*************************************************************************************
    127149! Calculate coupling period
    … …  
    200222    END IF
    201223
     224! calving initialization
     225    ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error)
     226    sum_error = sum_error + error
     227    ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)   
     228    sum_error = sum_error + error
     229    CALL gather_omp(longitude_deg,rlon_mpi)
     230    CALL gather_omp(latitude_deg,rlat_mpi)
     231    CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
     232    CALL gather_omp(cell_area,cell_area_mpi)
     233     
     234    IF (is_omp_root) THEN
     235      CALL Grid1DTo2D_mpi(rlon_mpi,lon2D)
     236      CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
     237      CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
     238      !--the next line is required for lat-lon grid and should have no impact
     239      !--for an unstructured grid for which nbp_lon=1
     240      !--if north pole in process mpi then divide cell area of pole cell by
     241      !number of replicates
     242      IF (is_north_pole_dyn) cell_area2D(:,1)=cell_area2D(:,1)/FLOAT(nbp_lon)
     243      !--if south pole in process mpi then divide cell area of pole cell by
     244      !number of replicates
     245      IF (is_south_pole_dyn) cell_area2D(:,jj_nb)=cell_area2D(:,jj_nb)/FLOAT(nbp_lon)
     246      mask_calving(:,:,:) = 0
     247      WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
     248      WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1
     249      WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1
     250   
     251   
     252      DO i=1,nb_zone_calving
     253        area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:)
     254        pos=1
     255        IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1)
     256     
     257        ind_calving(i)=0
     258        IF (grid_type==unstructured) THEN
     259          DO ig=1,klon_mpi
     260            IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig
     261          ENDDO
     262        ELSE IF (grid_type==regular_lonlat) THEN
     263          IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN
     264            ind_calving(i)=pos-(jj_begin-1)*nbp_lon
     265          ENDIF
     266        ENDIF
     267     
     268      ENDDO
     269    ENDIF
     270   
     271         
    202272    IF (sum_error /= 0) THEN
    203273       abort_message='Pb allocation variables couplees'
    … …  
    10391109! Local variables
    10401110!*************************************************************************************
    1041     INTEGER                                              :: error, sum_error, j
     1111    INTEGER                                              :: error, sum_error, i,j,k
    10421112    INTEGER                                              :: itau_w
    10431113    INTEGER                                              :: time_sec
    … …  
    10561126! Table with all fields to send to coupler
    10571127    REAL, DIMENSION(nbp_lon, jj_nb, maxsend)                 :: tab_flds
    1058     REAL, DIMENSION(klon_mpi)                            :: rlon_mpi, rlat_mpi
     1128    REAL, DIMENSION(klon_mpi)                                :: rlon_mpi, rlat_mpi
     1129    REAL  :: calving(nb_zone_calving)
     1130    REAL  :: calving_glo(nb_zone_calving)
    10591131
    10601132#ifdef CPP_MPI
    … …  
    10801152   
    10811153    IF (version_ocean=='nemo') THEN
    1082        tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
     1154       tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
    10831155       IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
    10841156    ELSE IF (version_ocean=='opa8') THEN
    … …  
    11071179!*************************************************************************************     
    11081180    IF (is_omp_root) THEN
    1109 
     1181     
     1182      IF (cpl_old_calving) THEN   ! use old calving
    11101183      DO j = 1, jj_nb
    11111184         tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), &
    … …  
    11361209         IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN
    11371210            Down=Down+tmp_calv(1,jj_nb)
    1138             tmp_calv(:,jj_nb)=Down       
     1211            tmp_calv(:,jj_nb)=Down
    11391212         ENDIF
    11401213      ENDIF
    11411214     
    11421215      tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
     1216
     1217      ELSE ! else old calving
     1218
     1219      DO k=1,nb_zone_calving
     1220        calving(k)=0
     1221        DO j = 1, jj_nb
     1222          calving(k)=calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic))
     1223        ENDDO
     1224      ENDDO
     1225     
     1226      CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
     1227     
     1228      tab_flds(:,:,ids_calvin) = 0
     1229      DO k=1,nb_zone_calving
     1230        IF (ind_calving(k)>0 ) THEN
     1231          j=(ind_calving(k)-1)/nbp_lon + 1
     1232          i=MOD(ind_calving(k)-1,nbp_lon)+1
     1233          tab_flds(i,j,ids_calvin) = calving_glo(k)
     1234        ENDIF
     1235      ENDDO
     1236      ENDIF ! endif old calving
    11431237
    11441238!*************************************************************************************
Note: See TracChangeset for help on using the changeset viewer.