Index: LMDZ5/branches/IPSLCM5A2.1/libf/dynphy_lonlat/inigeomphy_mod.F90 =================================================================== --- LMDZ5/branches/IPSLCM5A2.1/libf/dynphy_lonlat/inigeomphy_mod.F90 (revision 3674) +++ LMDZ5/branches/IPSLCM5A2.1/libf/dynphy_lonlat/inigeomphy_mod.F90 (revision 3889) @@ -73,5 +73,6 @@ REAL,ALLOCATABLE,SAVE :: boundslonfi(:,:) REAL,ALLOCATABLE,SAVE :: boundslatfi(:,:) -!$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi) + INTEGER,ALLOCATABLE,SAVE :: ind_cell_glo_fi(:) +!$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi,ind_cell_glo_fi) ! Initialize Physics distibution and parameters and interface with dynamics @@ -201,4 +202,5 @@ ALLOCATE(boundslonfi(klon_omp,4)) ALLOCATE(boundslatfi(klon_omp,4)) + ALLOCATE(ind_cell_glo_fi(klon_omp)) @@ -211,8 +213,9 @@ boundslonfi(1:klon_omp,:) = boundslonfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:) boundslatfi(1:klon_omp,:) = boundslatfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:) + ind_cell_glo_fi(1:klon_omp)=(/ (i,i=offset+klon_omp_begin,offset+klon_omp_end) /) ! copy over local grid longitudes and latitudes CALL init_geometry(klon_omp,lonfi,latfi,boundslonfi,boundslatfi, & - airefi,cufi,cvfi) + airefi,ind_cell_glo_fi,cufi,cvfi) !$OMP END PARALLEL Index: LMDZ5/branches/IPSLCM5A2.1/libf/phy_common/geometry_mod.F90 =================================================================== --- LMDZ5/branches/IPSLCM5A2.1/libf/phy_common/geometry_mod.F90 (revision 3674) +++ LMDZ5/branches/IPSLCM5A2.1/libf/phy_common/geometry_mod.F90 (revision 3889) @@ -30,4 +30,6 @@ !$OMP THREADPRIVATE(cell_area) + INTEGER,SAVE,ALLOCATABLE :: ind_cell_glo(:) ! global indice of a local cell +!$OMP THREADPRIVATE(ind_cell_glo) CONTAINS @@ -35,5 +37,5 @@ SUBROUTINE init_geometry(klon,longitude_,latitude_, & boundslon_,boundslat_, & - cell_area_,dx_,dy_) + cell_area_,ind_cell_glo_,dx_,dy_) USE mod_grid_phy_lmdz, ONLY: nvertex USE nrtype, ONLY : PI @@ -45,4 +47,5 @@ REAL,INTENT(IN) :: boundslat_(klon,nvertex) REAL,INTENT(IN) :: cell_area_(klon) + INTEGER,OPTIONAL,INTENT(IN) :: ind_cell_glo_(klon) REAL,OPTIONAL,INTENT(IN) :: dx_(klon) REAL,OPTIONAL,INTENT(IN) :: dy_(klon) @@ -55,4 +58,5 @@ ALLOCATE(boundslat(klon,nvertex)) ALLOCATE(cell_area(klon)) + IF (PRESENT(ind_cell_glo_)) ALLOCATE(ind_cell_glo(klon)) IF (PRESENT(dx_)) ALLOCATE(dx(klon)) IF (PRESENT(dy_))ALLOCATE(dy(klon)) @@ -65,4 +69,5 @@ boundslat(:,:) = boundslat_(:,:) cell_area(:) = cell_area_(:) + IF (PRESENT(ind_cell_glo_)) ind_cell_glo(:) = ind_cell_glo_(:) IF (PRESENT(dx_)) dx(:) = dx_(:) IF (PRESENT(dy_)) dy(:) = dy_(:) Index: LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/cpl_mod.F90 =================================================================== --- LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/cpl_mod.F90 (revision 3674) +++ LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/cpl_mod.F90 (revision 3889) @@ -93,4 +93,15 @@ !$OMP THREADPRIVATE(cpl_atm_co22D) +!!!!!!!!!! variable for calving + INTEGER, PARAMETER :: nb_zone_calving = 3 + REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving + !$OMP THREADPRIVATE(area_calving) + REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D + !$OMP THREADPRIVATE(cell_area2D) + INTEGER, SAVE :: ind_calving(nb_zone_calving) + !$OMP THREADPRIVATE(ind_calving) + LOGICAL,SAVE :: cpl_old_calving + !$OMP THREADPRIVATE(cpl_old_calving) + CONTAINS ! @@ -101,7 +112,9 @@ USE surface_data USE indice_sol_mod - USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat + USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, klon_glo, grid_type, unstructured, regular_lonlat USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy USE print_control_mod, ONLY: lunout + USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area + USE ioipsl_getin_p_mod, ONLY: getin_p ! Input arguments @@ -123,5 +136,14 @@ CHARACTER(len = 80) :: abort_message CHARACTER(len=80) :: clintocplnam, clfromcplnam - + REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi, cell_area_mpi + INTEGER, DIMENSION(klon_mpi) :: ind_cell_glo_mpi + REAL, DIMENSION(nbp_lon,jj_nb) :: lon2D, lat2D + INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving) + REAL :: pos +!*************************************** +! Use old calving or not (default no) + cpl_old_calving=.TRUE. + CALL getin_p("cpl_old_calving",cpl_old_calving) + print*,"cpl_old_calving = ",cpl_old_calving !************************************************************************************* ! Calculate coupling period @@ -200,4 +222,52 @@ END IF +! calving initialization + ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error) + sum_error = sum_error + error + ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error) + sum_error = sum_error + error + CALL gather_omp(longitude_deg,rlon_mpi) + CALL gather_omp(latitude_deg,rlat_mpi) + CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi) + CALL gather_omp(cell_area,cell_area_mpi) + + IF (is_omp_root) THEN + CALL Grid1DTo2D_mpi(rlon_mpi,lon2D) + CALL Grid1DTo2D_mpi(rlat_mpi,lat2D) + CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D) + !--the next line is required for lat-lon grid and should have no impact + !--for an unstructured grid for which nbp_lon=1 + !--if north pole in process mpi then divide cell area of pole cell by + !number of replicates + IF (is_north_pole_dyn) cell_area2D(:,1)=cell_area2D(:,1)/FLOAT(nbp_lon) + !--if south pole in process mpi then divide cell area of pole cell by + !number of replicates + IF (is_south_pole_dyn) cell_area2D(:,jj_nb)=cell_area2D(:,jj_nb)/FLOAT(nbp_lon) + mask_calving(:,:,:) = 0 + WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1 + WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1 + WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1 + + + DO i=1,nb_zone_calving + area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:) + pos=1 + IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1) + + ind_calving(i)=0 + IF (grid_type==unstructured) THEN + DO ig=1,klon_mpi + IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig + ENDDO + ELSE IF (grid_type==regular_lonlat) THEN + IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN + ind_calving(i)=pos-(jj_begin-1)*nbp_lon + ENDIF + ENDIF + + ENDDO + ENDIF + + IF (sum_error /= 0) THEN abort_message='Pb allocation variables couplees' @@ -1039,5 +1109,5 @@ ! Local variables !************************************************************************************* - INTEGER :: error, sum_error, j + INTEGER :: error, sum_error, i,j,k INTEGER :: itau_w INTEGER :: time_sec @@ -1056,5 +1126,7 @@ ! Table with all fields to send to coupler REAL, DIMENSION(nbp_lon, jj_nb, maxsend) :: tab_flds - REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi + REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi + REAL :: calving(nb_zone_calving) + REAL :: calving_glo(nb_zone_calving) #ifdef CPP_MPI @@ -1080,5 +1152,5 @@ IF (version_ocean=='nemo') THEN - tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:) + tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)) IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:) ELSE IF (version_ocean=='opa8') THEN @@ -1107,5 +1179,6 @@ !************************************************************************************* IF (is_omp_root) THEN - + + IF (cpl_old_calving) THEN ! use old calving DO j = 1, jj_nb tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), & @@ -1136,9 +1209,30 @@ IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN Down=Down+tmp_calv(1,jj_nb) - tmp_calv(:,jj_nb)=Down + tmp_calv(:,jj_nb)=Down ENDIF ENDIF tab_flds(:,:,ids_calvin) = tmp_calv(:,:) + + ELSE ! else old calving + + DO k=1,nb_zone_calving + calving(k)=0 + DO j = 1, jj_nb + calving(k)=calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic)) + ENDDO + ENDDO + + CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error) + + tab_flds(:,:,ids_calvin) = 0 + DO k=1,nb_zone_calving + IF (ind_calving(k)>0 ) THEN + j=(ind_calving(k)-1)/nbp_lon + 1 + i=MOD(ind_calving(k)-1,nbp_lon)+1 + tab_flds(i,j,ids_calvin) = calving_glo(k) + ENDIF + ENDDO + ENDIF ! endif old calving !*************************************************************************************