! MODULE cpl_mod ! ! This module excahanges and transforms all fields that should be recieved or sent to ! coupler. The transformation of the fields are done from the grid 1D-array in phylmd ! to the regular 2D grid accepted by the coupler. Cumulation of the fields for each ! timestep is done in here. ! ! Each type of surface that recevie fields from the coupler have a subroutine named ! cpl_receive_XXX_fields and each surface that have fields to be sent to the coupler ! have a subroutine named cpl_send_XXX_fields. ! !************************************************************************************* ! Use statements !************************************************************************************* USE dimphy, ONLY : klon USE mod_phys_lmdz_para USE ioipsl USE iophy ! The module oasis is always used. Without the cpp key CPP_COUPLE only the parameters ! in the module are compiled and not the subroutines. USE oasis USE write_field_phy USE time_phylmdz_mod, ONLY: day_step_phy ! Global attributes !************************************************************************************* IMPLICIT NONE PRIVATE ! All subroutine are public except cpl_send_all PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, & cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, & cpl_send_landice_fields, gath2cpl ! Declaration of module variables !************************************************************************************* ! variable for coupling period INTEGER, SAVE :: nexca !$OMP THREADPRIVATE(nexca) ! variables for cumulating fields during a coupling periode : REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sols, cpl_nsol, cpl_rain !$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_snow, cpl_evap, cpl_tsol !$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol) REAL, ALLOCATABLE, SAVE:: cpl_delta_sst(:), cpl_delta_sal(:), cpl_dter(:), cpl_dser(:), cpl_dt_ds(:) !$OMP THREADPRIVATE(cpl_delta_sst, cpl_delta_sal, cpl_dter, cpl_dser) !$OMP THREADPRIVATE(cpl_dt_ds) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp !$OMP THREADPRIVATE(cpl_windsp) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sens_rain, cpl_sens_snow !$OMP THREADPRIVATE(cpl_sens_rain, cpl_sens_snow) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_taumod !$OMP THREADPRIVATE(cpl_taumod) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co2 !$OMP THREADPRIVATE(cpl_atm_co2) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D !$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: rlic_in_frac2D ! fraction for continental ice !$OMP THREADPRIVATE(rlic_in_frac2D) ! variables read from coupler : REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sst ! sea surface temperature !$OMP THREADPRIVATE(read_sst) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sit ! sea ice temperature !$OMP THREADPRIVATE(read_sit) REAL, ALLOCATABLE, SAVE:: read_sss(:, :) ! bulk salinity of the surface layer of the ocean, in ppt !$OMP THREADPRIVATE(read_sss) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sic ! sea ice fraction !$OMP THREADPRIVATE(read_sic) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_alb_sic ! albedo at sea ice !$OMP THREADPRIVATE(read_alb_sic) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_u0, read_v0 ! ocean surface current !$OMP THREADPRIVATE(read_u0,read_v0) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_co2 ! ocean co2 flux !$OMP THREADPRIVATE(read_co2) INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: unity !$OMP THREADPRIVATE(unity) INTEGER, SAVE :: nidct, nidcs !$OMP THREADPRIVATE(nidct,nidcs) ! variables to be sent to the coupler REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D !$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D) REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D !$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D) REAL, ALLOCATABLE, SAVE:: cpl_delta_sst_2D(:, :), cpl_delta_sal_2D(:, :) REAL, ALLOCATABLE, SAVE:: cpl_dter_2D(:, :), cpl_dser_2D(:, :), cpl_dt_ds_2D(:, :) !$OMP THREADPRIVATE(cpl_delta_sst_2D, cpl_delta_sal_2D) !$OMP THREADPRIVATE(cpl_dter_2D, cpl_dser_2D, cpl_dt_ds_2D) REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D !$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D) REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D !$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D) REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D !$OMP THREADPRIVATE(cpl_taumod2D) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D !$OMP THREADPRIVATE(cpl_windsp2D) REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sens_rain2D, cpl_sens_snow2D !$OMP THREADPRIVATE(cpl_sens_rain2D, cpl_sens_snow2D) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co22D !$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 ! !************************************************************************************ ! SUBROUTINE cpl_init(dtime, rlon, rlat) USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day USE surface_data USE indice_sol_mod USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, 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 use config_ocean_skin_m, only: activate_ocean_skin ! Input arguments !************************************************************************************* REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat ! Local variables !************************************************************************************* INTEGER :: error, sum_error, ig, i INTEGER :: jf, nhoridct INTEGER :: nhoridcs INTEGER :: idtime INTEGER :: idayref INTEGER :: npas ! only for OASIS2 REAL :: zjulian REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat CHARACTER(len = 20) :: modname = 'cpl_init' 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 new calving method) ! New calving method should be used with DYNAMICO and when using new coupling ! weights. cpl_old_calving=.FALSE. CALL getin_p("cpl_old_calving",cpl_old_calving) WRITE(lunout,*)' cpl_old_calving = ', cpl_old_calving !************************************************************************************* ! Calculate coupling period ! !************************************************************************************* npas = itaufin_phy ! nexca = 86400 / dtime nexca = t_coupl / dtime WRITE(lunout,*)' ##### Ocean couple #####' WRITE(lunout,*)' Valeurs des pas de temps' WRITE(lunout,*)' npas = ', npas WRITE(lunout,*)' nexca = ', nexca !************************************************************************************* ! Allocate variables ! !************************************************************************************* error = 0 sum_error = 0 ALLOCATE(unity(klon), stat = error) sum_error = sum_error + error ALLOCATE(cpl_sols(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_nsol(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_rain(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_snow(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_evap(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_tsol(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_fder(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_albe(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_taux(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_tauy(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_windsp(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_taumod(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_sens_rain(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_sens_snow(klon,2), stat = error) sum_error = sum_error + error ALLOCATE(cpl_rriv2D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ALLOCATE(cpl_rcoa2D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ALLOCATE(cpl_rlic2D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ALLOCATE(rlic_in_frac2D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ALLOCATE(read_sst(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error ALLOCATE(read_sic(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error ALLOCATE(read_sit(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error if (activate_ocean_skin >= 1) then ALLOCATE(read_sss(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error if (activate_ocean_skin == 2) then ALLOCATE(cpl_delta_sst(klon), cpl_delta_sal(klon), cpl_dter(klon), & cpl_dser(klon), cpl_dt_ds(klon), stat = error) sum_error = sum_error + error end if end if ALLOCATE(read_alb_sic(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error ALLOCATE(read_u0(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error ALLOCATE(read_v0(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error IF (carbon_cycle_cpl) THEN ALLOCATE(read_co2(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error ALLOCATE(cpl_atm_co2(klon,2), stat = error) sum_error = sum_error + error ! Allocate variable in carbon_cycle_mod IF (.NOT.ALLOCATED(fco2_ocn_day)) ALLOCATE(fco2_ocn_day(klon), stat = error) sum_error = sum_error + error ENDIF ! 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_master) 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' CALL abort_physic(modname,abort_message,1) ENDIF !************************************************************************************* ! Initialize the allocated varaibles ! !************************************************************************************* DO ig = 1, klon unity(ig) = ig ENDDO !************************************************************************************* ! Initialize coupling ! !************************************************************************************* idtime = INT(dtime) #ifdef CPP_COUPLE CALL inicma #endif !************************************************************************************* ! initialize NetCDF output ! !************************************************************************************* IF (is_sequential) THEN idayref = day_ini CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) CALL grid1dTo2d_glo(rlon,zx_lon) DO i = 1, nbp_lon zx_lon(i,1) = rlon(i+1) zx_lon(i,nbp_lat) = rlon(i+1) ENDDO CALL grid1dTo2d_glo(rlat,zx_lat) clintocplnam="cpl_atm_tauflx" CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),& 1,nbp_lon,1,nbp_lat, itau_phy,zjulian,dtime,nhoridct,nidct) ! no vertical axis CALL histdef(nidct, 'tauxe','tauxe', & "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) CALL histdef(nidct, 'tauyn','tauyn', & "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) CALL histdef(nidct, 'tmp_lon','tmp_lon', & "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) CALL histdef(nidct, 'tmp_lat','tmp_lat', & "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) DO jf=1,maxsend_phys IF (infosend(i)%action) THEN CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , & "-",nbp_lon,nbp_lat,nhoridct,1,1,1,-99,32,"inst",dtime,dtime) ENDIF ENDDO CALL histend(nidct) CALL histsync(nidct) clfromcplnam="cpl_atm_sst" CALL histbeg(clfromcplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),1,nbp_lon,1,nbp_lat, & 0,zjulian,dtime,nhoridcs,nidcs) ! no vertical axis DO jf=1,maxrecv_phys IF (inforecv(i)%action) THEN CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , & "-",nbp_lon,nbp_lat,nhoridcs,1,1,1,-99,32,"inst",dtime,dtime) ENDIF ENDDO CALL histend(nidcs) CALL histsync(nidcs) ENDIF ! is_sequential !************************************************************************************* ! compatibility test ! !************************************************************************************* IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN abort_message='carbon_cycle_cpl does not work with opa8' CALL abort_physic(modname,abort_message,1) ENDIF END SUBROUTINE cpl_init ! !************************************************************************************* ! SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified) ! This subroutine receives from coupler for both ocean and seaice ! 4 fields : read_sst, read_sic, read_sit and read_alb_sic. ! The new sea-ice-land-landice fraction is returned. The others fields ! are stored in this module. USE yomcst_mod_h USE surface_data USE geometry_mod, ONLY : longitude_deg, latitude_deg USE carbon_cycle_mod, ONLY : carbon_cycle_cpl USE indice_sol_mod USE time_phylmdz_mod, ONLY: start_time, itau_phy USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat use config_ocean_skin_m, only: activate_ocean_skin ! Arguments !************************************************************************************ INTEGER, INTENT(IN) :: itime REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf LOGICAL, INTENT(OUT) :: is_modified ! Local variables !************************************************************************************ INTEGER :: j, i, time_sec INTEGER :: itau_w INTEGER, DIMENSION(nbp_lon*nbp_lat) :: ndexcs CHARACTER(len = 20) :: modname = 'cpl_receive_frac' CHARACTER(len = 80) :: abort_message REAL, DIMENSION(klon) :: read_sic1D REAL, DIMENSION(nbp_lon,jj_nb,maxrecv_phys) :: tab_read_flds REAL, DIMENSION(klon,nbsrf) :: pctsrf_old REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_lon, tmp_lat REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_r0 !************************************************************************************* ! Start calculation ! Get fields from coupler ! !************************************************************************************* is_modified=.FALSE. ! Check if right moment to receive from coupler IF (MOD(itime, nexca) == 1) THEN is_modified=.TRUE. time_sec=(itime-1)*dtime #ifdef CPP_COUPLE !$OMP MASTER CALL fromcpl(time_sec, tab_read_flds) !$OMP END MASTER #endif ! NetCDF output of received fields IF (is_sequential) THEN ndexcs(:) = 0 itau_w = itau_phy + itime + start_time * day_step_phy DO i = 1, maxrecv_phys IF (inforecv(i)%action) THEN CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs) ENDIF ENDDO ENDIF ! Save each field in a 2D array. !$OMP MASTER read_sst(:,:) = tab_read_flds(:,:,idr_sisutw) ! Sea surface temperature read_sic(:,:) = tab_read_flds(:,:,idr_icecov) ! Sea ice concentration read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw) ! Albedo at sea ice read_sit(:,:) = tab_read_flds(:,:,idr_icetem) ! Sea ice temperature if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss) !$OMP END MASTER IF (cpl_current) THEN ! Transform the longitudes and latitudes on 2D arrays CALL gather_omp(longitude_deg,rlon_mpi) CALL gather_omp(latitude_deg,rlat_mpi) !$OMP MASTER CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon) CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat) ! Transform the currents from cartesian to spheric coordinates ! tmp_r0 should be zero CALL geo2atm(nbp_lon, jj_nb, tab_read_flds(:,:,idr_curenx), & tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), & tmp_lon, tmp_lat, & read_u0(:,:), read_v0(:,:), tmp_r0(:,:)) !$OMP END MASTER ELSE read_u0(:,:) = 0. read_v0(:,:) = 0. ENDIF IF (carbon_cycle_cpl) THEN !$OMP MASTER read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux !$OMP END MASTER ENDIF !************************************************************************************* ! Transform seaice fraction (read_sic : ocean-seaice mask) into global ! fraction (pctsrf : ocean-seaice-land-landice mask) ! !************************************************************************************* CALL cpl2gath(read_sic, read_sic1D, klon, unity) pctsrf_old(:,:) = pctsrf(:,:) DO i = 1, klon ! treatment only of points with ocean and/or seaice ! old land-ocean mask can not be changed IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & * read_sic1D(i) pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & - pctsrf(i,is_sic) ENDIF ENDDO ENDIF ! if time to receive END SUBROUTINE cpl_receive_frac ! !************************************************************************************* ! SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, & v0_new, sss) ! ! This routine returns the field for the ocean that has been read from the coupler ! (done earlier with cpl_receive_frac). The field is the temperature. ! The temperature is transformed into 1D array with valid points from index 1 to knon. ! USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day USE indice_sol_mod use config_ocean_skin_m, only: activate_ocean_skin ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! Output arguments !************************************************************************************* REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new REAL, INTENT(OUT):: sss(:) ! (klon) ! bulk salinity of the surface layer of the ocean, in ppt REAL, DIMENSION(klon), INTENT(OUT) :: u0_new REAL, DIMENSION(klon), INTENT(OUT) :: v0_new ! Local variables !************************************************************************************* INTEGER :: i INTEGER, DIMENSION(klon) :: index REAL, DIMENSION(klon) :: sic_new !************************************************************************************* ! Transform read_sst into compressed 1D variable tsurf_new ! !************************************************************************************* CALL cpl2gath(read_sst, tsurf_new, knon, knindex) if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex) CALL cpl2gath(read_sic, sic_new, knon, knindex) CALL cpl2gath(read_u0, u0_new, knon, knindex) CALL cpl2gath(read_v0, v0_new, knon, knindex) !************************************************************************************* ! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in ! the module carbon_cycle_mod ! !************************************************************************************* IF (carbon_cycle_cpl) THEN DO i=1,klon index(i)=i ENDDO CALL cpl2gath(read_co2, fco2_ocn_day, klon, index) ENDIF !************************************************************************************* ! The fields received from the coupler have to be weighted with the fraction of ocean ! in relation to the total sea-ice+ocean ! !************************************************************************************* DO i=1, knon tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i)) ENDDO END SUBROUTINE cpl_receive_ocean_fields ! !************************************************************************************* ! SUBROUTINE cpl_receive_seaice_fields(knon, knindex, & tsurf_new, alb_new, u0_new, v0_new) ! ! This routine returns the fields for the seaice that have been read from the coupler ! (done earlier with cpl_receive_frac). These fields are the temperature and ! albedo at sea ice surface and fraction of sea ice. ! The fields are transformed into 1D arrays with valid points from index 1 to knon. ! ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! Output arguments !************************************************************************************* REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new REAL, DIMENSION(klon), INTENT(OUT) :: alb_new REAL, DIMENSION(klon), INTENT(OUT) :: u0_new REAL, DIMENSION(klon), INTENT(OUT) :: v0_new ! Local variables !************************************************************************************* INTEGER :: i REAL, DIMENSION(klon) :: sic_new !************************************************************************************* ! Transform fields read from coupler from 2D into compressed 1D variables ! !************************************************************************************* CALL cpl2gath(read_sit, tsurf_new, knon, knindex) CALL cpl2gath(read_alb_sic, alb_new, knon, knindex) CALL cpl2gath(read_sic, sic_new, knon, knindex) CALL cpl2gath(read_u0, u0_new, knon, knindex) CALL cpl2gath(read_v0, v0_new, knon, knindex) !************************************************************************************* ! The fields received from the coupler have to be weighted with the sea-ice ! concentration (in relation to the total sea-ice + ocean). ! !************************************************************************************* DO i= 1, knon tsurf_new(i) = tsurf_new(i) / sic_new(i) alb_new(i) = alb_new(i) / sic_new(i) ENDDO END SUBROUTINE cpl_receive_seaice_fields ! !************************************************************************************* ! SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, & swdown, lwdown, fluxlat, fluxsens, & precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,& sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, delta_sst, & delta_sal, dTer, dSer, dt_ds) ! This subroutine cumulates some fields for each time-step during ! a coupling period. At last time-step in a coupling period the ! fields are transformed to the grid accepted by the coupler. No ! sending to the coupler will be done from here (it is done in ! cpl_send_seaice_fields). Crucial hypothesis is that the surface ! fractions do not change between coupling time-steps. USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send USE indice_sol_mod USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat use config_ocean_skin_m, only: activate_ocean_skin ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: itime INTEGER, INTENT(IN) :: knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder, albsol REAL, DIMENSION(klon), INTENT(IN) :: taux, tauy, windsp REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon) REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol REAL, intent(in):: delta_sst(:) ! (knon) ! Ocean-air interface temperature minus bulk SST, in ! K. Defined only if activate_ocean_skin >= 1. real, intent(in):: delta_sal(:) ! (knon) ! Ocean-air interface salinity minus bulk salinity, in ppt. REAL, intent(in):: dter(:) ! (knon) ! Temperature variation in the diffusive microlayer, that is ! ocean-air interface temperature minus subskin temperature. In ! K. REAL, intent(in):: dser(:) ! (knon) ! Salinity variation in the diffusive microlayer, that is ! ocean-air interface salinity minus subskin salinity. In ppt. real, intent(in):: dt_ds(:) ! (knon) ! (tks / tkt) * dTer, in K ! Local variables !************************************************************************************* INTEGER :: cpl_index, ig INTEGER :: error, sum_error CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields' CHARACTER(len = 80) :: abort_message !************************************************************************************* ! Start calculation ! The ocean points are saved with second array index=1 ! !************************************************************************************* cpl_index = 1 !************************************************************************************* ! Reset fields to zero in the beginning of a new coupling period ! !************************************************************************************* IF (MOD(itime, nexca) == 1) THEN cpl_sols(1:knon,cpl_index) = 0.0 cpl_nsol(1:knon,cpl_index) = 0.0 cpl_rain(1:knon,cpl_index) = 0.0 cpl_snow(1:knon,cpl_index) = 0.0 cpl_evap(1:knon,cpl_index) = 0.0 cpl_tsol(1:knon,cpl_index) = 0.0 cpl_fder(1:knon,cpl_index) = 0.0 cpl_albe(1:knon,cpl_index) = 0.0 cpl_taux(1:knon,cpl_index) = 0.0 cpl_tauy(1:knon,cpl_index) = 0.0 cpl_windsp(1:knon,cpl_index) = 0.0 cpl_sens_rain(1:knon,cpl_index) = 0.0 cpl_sens_snow(1:knon,cpl_index) = 0.0 cpl_taumod(1:knon,cpl_index) = 0.0 IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0 if (activate_ocean_skin == 2) then cpl_delta_sst = 0. cpl_delta_sal = 0. cpl_dter = 0. cpl_dser = 0. cpl_dt_ds = 0. end if ENDIF !************************************************************************************* ! Cumulate at each time-step ! !************************************************************************************* DO ig = 1, knon cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & swdown(ig) / REAL(nexca) cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca) cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & precip_rain(ig) / REAL(nexca) cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & precip_snow(ig) / REAL(nexca) cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & evap(ig) / REAL(nexca) cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & tsurf(ig) / REAL(nexca) cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & fder(ig) / REAL(nexca) cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & albsol(ig) / REAL(nexca) cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & taux(ig) / REAL(nexca) cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & tauy(ig) / REAL(nexca) cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + & windsp(ig) / REAL(nexca) cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + & sens_prec_liq(ig) / REAL(nexca) cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + & sens_prec_sol(ig) / REAL(nexca) cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + & SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL (nexca) IF (carbon_cycle_cpl) THEN cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + & co2_send(knindex(ig))/ REAL(nexca) !!---OB: this is correct but why knindex ?? ENDIF if (activate_ocean_skin == 2) then cpl_delta_sst(ig) = cpl_delta_sst(ig) + delta_sst(ig) / REAL(nexca) cpl_delta_sal(ig) = cpl_delta_sal(ig) + delta_sal(ig) / REAL(nexca) cpl_dter(ig) = cpl_dter(ig) + dter(ig) / REAL(nexca) cpl_dser(ig) = cpl_dser(ig) + dser(ig) / REAL(nexca) cpl_dt_ds(ig) = cpl_dt_ds(ig) + dt_ds(ig) / REAL(nexca) end if ENDDO !************************************************************************************* ! If the time-step corresponds to the end of coupling period the ! fields are transformed to the 2D grid. ! No sending to the coupler (it is done from cpl_send_seaice_fields). ! !************************************************************************************* IF (MOD(itime, nexca) == 0) THEN IF (.NOT. ALLOCATED(cpl_sols2D)) THEN sum_error = 0 ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error IF (carbon_cycle_cpl) THEN ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ENDIF if (activate_ocean_skin == 2) then ALLOCATE(cpl_delta_sst_2D(nbp_lon, jj_nb), & cpl_delta_sal_2D(nbp_lon, jj_nb), & cpl_dter_2D(nbp_lon, jj_nb), cpl_dser_2D(nbp_lon, jj_nb), & cpl_dt_ds_2D(nbp_lon, jj_nb), stat = error) sum_error = sum_error + error end if IF (sum_error /= 0) THEN abort_message='Pb allocation variables couplees pour l''ecriture' CALL abort_physic(modname,abort_message,1) ENDIF ENDIF CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), & knon, knindex) ! cpl_tsol2D(:,:,:) not used! CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), & knon, knindex) ! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)! CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), & knon, knindex) ! cpl_albe2D(:,:,:) not used! CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), & knon, knindex) CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), & knon, knindex) IF (carbon_cycle_cpl) & CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex) if (activate_ocean_skin == 2) then CALL gath2cpl(cpl_delta_sst, cpl_delta_sst_2D, knon, knindex) CALL gath2cpl(cpl_delta_sal, cpl_delta_sal_2D, knon, knindex) CALL gath2cpl(cpl_dter, cpl_dter_2D, knon, knindex) CALL gath2cpl(cpl_dser, cpl_dser_2D, knon, knindex) CALL gath2cpl(cpl_dt_ds, cpl_dt_ds_2D, knon, knindex) end if ENDIF END SUBROUTINE cpl_send_ocean_fields ! !************************************************************************************* ! SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, & pctsrf, lafin, rlon, rlat, & swdown, lwdown, fluxlat, fluxsens, & precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy,& sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol) ! ! This subroutine cumulates some fields for each time-step during a coupling ! period. At last time-step in a coupling period the fields are transformed to the ! grid accepted by the coupler. All fields for all types of surfaces are sent to ! the coupler. ! USE carbon_cycle_mod, ONLY : carbon_cycle_cpl USE indice_sol_mod USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: itime INTEGER, INTENT(IN) :: knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder REAL, DIMENSION(klon), INTENT(IN) :: albsol, taux, tauy REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon) REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol LOGICAL, INTENT(IN) :: lafin ! Local variables !************************************************************************************* INTEGER :: cpl_index, ig INTEGER :: error, sum_error CHARACTER(len = 25) :: modname = 'cpl_send_seaice_fields' CHARACTER(len = 80) :: abort_message REAL, DIMENSION(klon) :: cpl_fder_tmp !************************************************************************************* ! Start calulation ! The sea-ice points are saved with second array index=2 ! !************************************************************************************* cpl_index = 2 !************************************************************************************* ! Reset fields to zero in the beginning of a new coupling period ! !************************************************************************************* IF (MOD(itime, nexca) == 1) THEN cpl_sols(1:knon,cpl_index) = 0.0 cpl_nsol(1:knon,cpl_index) = 0.0 cpl_rain(1:knon,cpl_index) = 0.0 cpl_snow(1:knon,cpl_index) = 0.0 cpl_evap(1:knon,cpl_index) = 0.0 cpl_tsol(1:knon,cpl_index) = 0.0 cpl_fder(1:knon,cpl_index) = 0.0 cpl_albe(1:knon,cpl_index) = 0.0 cpl_taux(1:knon,cpl_index) = 0.0 cpl_tauy(1:knon,cpl_index) = 0.0 cpl_sens_rain(1:knon,cpl_index) = 0.0 cpl_sens_snow(1:knon,cpl_index) = 0.0 cpl_taumod(1:knon,cpl_index) = 0.0 ENDIF !************************************************************************************* ! Cumulate at each time-step ! !************************************************************************************* DO ig = 1, knon cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & swdown(ig) / REAL(nexca) cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca) cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & precip_rain(ig) / REAL(nexca) cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & precip_snow(ig) / REAL(nexca) cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & evap(ig) / REAL(nexca) cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & tsurf(ig) / REAL(nexca) cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & fder(ig) / REAL(nexca) cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & albsol(ig) / REAL(nexca) cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & taux(ig) / REAL(nexca) cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & tauy(ig) / REAL(nexca) cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + & sens_prec_liq(ig) / REAL(nexca) cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + & sens_prec_sol(ig) / REAL(nexca) cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + & SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL(nexca) ENDDO !************************************************************************************* ! If the time-step corresponds to the end of coupling period the ! fields are transformed to the 2D grid and all fields are sent to coupler. ! !************************************************************************************* IF (MOD(itime, nexca) == 0) THEN IF (.NOT. ALLOCATED(cpl_sols2D)) THEN sum_error = 0 ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error) sum_error = sum_error + error IF (carbon_cycle_cpl) THEN ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error) sum_error = sum_error + error ENDIF IF (sum_error /= 0) THEN abort_message='Pb allocation variables couplees pour l''ecriture' CALL abort_physic(modname,abort_message,1) ENDIF ENDIF CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), & knon, knindex) ! cpl_tsol2D(:,:,:) not used! CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), & knon, knindex) ! Set default value and decompress before gath2cpl cpl_fder_tmp(:) = -20. DO ig = 1, knon cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index) ENDDO CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), & klon, unity) ! cpl_albe2D(:,:,:) not used! CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), & knon, knindex) CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), & knon, knindex) ! Send all fields CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat) ENDIF END SUBROUTINE cpl_send_seaice_fields ! !************************************************************************************* ! SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in) ! ! This subroutine cumulates some fields for each time-step during a coupling ! period. At last time-step in a coupling period the fields are transformed to the ! grid accepted by the coupler. No sending to the coupler will be done from here ! (it is done in cpl_send_seaice_fields). ! USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: itime INTEGER, INTENT(IN) :: knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex REAL, DIMENSION(klon), INTENT(IN) :: rriv_in REAL, DIMENSION(klon), INTENT(IN) :: rcoa_in ! Local variables !************************************************************************************* REAL, DIMENSION(nbp_lon,jj_nb) :: rriv2D REAL, DIMENSION(nbp_lon,jj_nb) :: rcoa2D !************************************************************************************* ! Rearrange fields in 2D variables ! First initialize to zero to avoid unvalid points causing problems ! !************************************************************************************* !$OMP MASTER rriv2D(:,:) = 0.0 rcoa2D(:,:) = 0.0 !$OMP END MASTER CALL gath2cpl(rriv_in, rriv2D, knon, knindex) CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex) !************************************************************************************* ! Reset cumulated fields to zero in the beginning of a new coupling period ! !************************************************************************************* IF (MOD(itime, nexca) == 1) THEN !$OMP MASTER cpl_rriv2D(:,:) = 0.0 cpl_rcoa2D(:,:) = 0.0 !$OMP END MASTER ENDIF !************************************************************************************* ! Cumulate : Following fields should be cumulated at each time-step ! !************************************************************************************* !$OMP MASTER cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca) cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca) !$OMP END MASTER END SUBROUTINE cpl_send_land_fields ! !************************************************************************************* ! SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in, rlic_in_frac) ! This subroutine cumulates the field for melting ice for each time-step ! during a coupling period. This routine will not send to coupler. Sending ! will be done in cpl_send_seaice_fields. ! USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat ! Input varibales !************************************************************************************* INTEGER, INTENT(IN) :: itime INTEGER, INTENT(IN) :: knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex REAL, DIMENSION(klon), INTENT(IN) :: rlic_in REAL, DIMENSION(klon), INTENT(IN) :: rlic_in_frac ! Fraction for continental ice, can be equal to ! pctsrf(:,is_lic) or not, depending on landice_opt ! Local varibales !************************************************************************************* REAL, DIMENSION(nbp_lon,jj_nb) :: rlic2D !************************************************************************************* ! Rearrange field in a 2D variable ! First initialize to zero to avoid unvalid points causing problems ! !************************************************************************************* !$OMP MASTER rlic2D(:,:) = 0.0 !$OMP END MASTER CALL gath2cpl(rlic_in, rlic2D, knon, knindex) CALL gath2cpl(rlic_in_frac(:), rlic_in_frac2D(:,:), knon, knindex) !************************************************************************************* ! Reset field to zero in the beginning of a new coupling period ! !************************************************************************************* IF (MOD(itime, nexca) == 1) THEN !$OMP MASTER cpl_rlic2D(:,:) = 0.0 !$OMP END MASTER ENDIF !************************************************************************************* ! Cumulate : Melting ice should be cumulated at each time-step ! !************************************************************************************* !$OMP MASTER cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca) !$OMP END MASTER END SUBROUTINE cpl_send_landice_fields ! !************************************************************************************* ! SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat) ! This routine will send fields for all different surfaces to the coupler. ! This subroutine should be executed after calculations by the last surface(sea-ice), ! all calculations at the different surfaces have to be done before. ! USE surface_data USE carbon_cycle_mod, ONLY : carbon_cycle_cpl USE indice_sol_mod USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat USE time_phylmdz_mod, ONLY: start_time, itau_phy USE config_ocean_skin_m, only: activate_ocean_skin USE lmdz_mpi ! Some includes ! ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: itime REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf LOGICAL, INTENT(IN) :: lafin ! Local variables !************************************************************************************* INTEGER :: error, sum_error, i,j,k INTEGER :: itau_w INTEGER :: time_sec INTEGER, DIMENSION(nbp_lon*(nbp_lat)) :: ndexct REAL :: Up, Down REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_lon, tmp_lat REAL, DIMENSION(nbp_lon, jj_nb, 4) :: pctsrf2D REAL, DIMENSION(nbp_lon, jj_nb) :: deno CHARACTER(len = 20) :: modname = 'cpl_send_all' CHARACTER(len = 80) :: abort_message ! Variables with fields to coupler REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_taux REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_tauy REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_calv ! Table with all fields to send to coupler REAL, DIMENSION(nbp_lon, jj_nb, maxsend_phys) :: tab_flds REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi REAL :: calving(nb_zone_calving) REAL :: calving_glo(nb_zone_calving) INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status ! End definitions !************************************************************************************* !************************************************************************************* ! All fields are stored in a table tab_flds(:,:,:) ! First store the fields which are already on the right format ! !************************************************************************************* !$OMP MASTER tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:) tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2) tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2) tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2) tab_flds(:,:,ids_qraioc) = cpl_sens_rain2D(:,:,1) tab_flds(:,:,ids_qsnooc) = cpl_sens_snow2D(:,:,1) tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2) tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2) if (activate_ocean_skin == 2) then tab_flds(:, :, ids_delta_sst) = cpl_delta_sst_2D tab_flds(:, :, ids_delta_sal) = cpl_delta_sal_2D tab_flds(:, :, ids_dter) = cpl_dter_2D tab_flds(:, :, ids_dser) = cpl_dser_2D tab_flds(:, :, ids_dt_ds) = cpl_dt_ds_2D end if IF (version_ocean=='nemo') THEN 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 tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1) tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1) tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1) tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:) tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:) ENDIF !************************************************************************************* ! Transform the fraction of sub-surfaces from 1D to 2D array ! !************************************************************************************* pctsrf2D(:,:,:) = 0. !$OMP END MASTER CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity) CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity) !************************************************************************************* ! Calculate the average calving per latitude ! Store calving in tab_flds(:,:,19) ! !************************************************************************************* 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), & rlic_in_frac2D(1:nbp_lon,j)) / REAL(nbp_lon) ENDDO IF (is_parallel) THEN IF (.NOT. is_north_pole_dyn) THEN CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error) CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error) ENDIF IF (.NOT. is_south_pole_dyn) THEN CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error) CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error) ENDIF IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN Up=Up+tmp_calv(nbp_lon,1) tmp_calv(:,1)=Up ENDIF IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN Down=Down+tmp_calv(1,jj_nb) tmp_calv(:,jj_nb)=Down ENDIF ENDIF tab_flds(:,:,ids_calvin) = tmp_calv(:,:) ELSE ! cpl_old_calving=FALSE ! To be used with new method for calculation of coupling weights 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),rlic_in_frac2D(:,j)) 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 !************************************************************************************* ! Calculate total flux for snow, rain and wind with weighted addition using the ! fractions of ocean and seaice. ! !************************************************************************************* ! fraction oce+seaice deno = pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic) IF (version_ocean=='nemo') THEN tab_flds(:,:,ids_shftot) = 0.0 tab_flds(:,:,ids_nsftot) = 0.0 tab_flds(:,:,ids_totrai) = 0.0 tab_flds(:,:,ids_totsno) = 0.0 tab_flds(:,:,ids_toteva) = 0.0 tab_flds(:,:,ids_taumod) = 0.0 tmp_taux(:,:) = 0.0 tmp_tauy(:,:) = 0.0 ! For all valid grid cells containing some fraction of ocean or sea-ice WHERE ( deno(:,:) /= 0 ) tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) ENDWHERE tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) ELSE IF (version_ocean=='opa8') THEN ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16) tab_flds(:,:,ids_totrai) = 0.0 tab_flds(:,:,ids_totsno) = 0.0 tmp_taux(:,:) = 0.0 tmp_tauy(:,:) = 0.0 ! For all valid grid cells containing some fraction of ocean or sea-ice WHERE ( deno(:,:) /= 0 ) tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) ENDWHERE ENDIF ENDIF ! is_omp_root !************************************************************************************* ! Transform the wind components from local atmospheric 2D coordinates to geocentric ! 3D coordinates. ! Store the resulting wind components in tab_flds(:,:,1:6) !************************************************************************************* ! Transform the longitudes and latitudes on 2D arrays CALL gather_omp(rlon,rlon_mpi) CALL gather_omp(rlat,rlat_mpi) !$OMP MASTER CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon) CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat) !$OMP END MASTER IF (is_sequential) THEN IF (is_north_pole_dyn) tmp_lon(:,1) = tmp_lon(:,2) IF (is_south_pole_dyn) tmp_lon(:,nbp_lat) = tmp_lon(:,nbp_lat-1) ENDIF ! NetCDF output of the wind before transformation of coordinate system IF (is_sequential) THEN ndexct(:) = 0 itau_w = itau_phy + itime + start_time * day_step_phy CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,nbp_lon*(nbp_lat),ndexct) CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,nbp_lon*(nbp_lat),ndexct) CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,nbp_lon*(nbp_lat),ndexct) CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,nbp_lon*(nbp_lat),ndexct) ENDIF ! Transform the wind from spherical atmospheric 2D coordinates to geocentric ! cartesian 3D coordinates !$OMP MASTER CALL atm2geo (nbp_lon, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, & tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) ) tab_flds(:,:,ids_tauxxv) = tab_flds(:,:,ids_tauxxu) tab_flds(:,:,ids_tauyyv) = tab_flds(:,:,ids_tauyyu) tab_flds(:,:,ids_tauzzv) = tab_flds(:,:,ids_tauzzu) !$OMP END MASTER !************************************************************************************* ! NetCDF output of all fields just before sending to coupler. ! !************************************************************************************* IF (is_sequential) THEN DO j=1,maxsend_phys IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, & tab_flds(:,:,j),nbp_lon*(nbp_lat),ndexct) ENDDO ENDIF !************************************************************************************* ! Send the table of all fields ! !************************************************************************************* time_sec=(itime-1)*dtime #ifdef CPP_COUPLE !$OMP MASTER CALL intocpl(time_sec, lafin, tab_flds(:,:,:)) !$OMP END MASTER #endif !************************************************************************************* ! Finish with some dellocate ! !************************************************************************************* sum_error=0 DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error ) sum_error = sum_error + error DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error ) sum_error = sum_error + error DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error ) sum_error = sum_error + error DEALLOCATE(cpl_sens_rain2D, cpl_sens_snow2D, stat=error) sum_error = sum_error + error IF (carbon_cycle_cpl) THEN DEALLOCATE(cpl_atm_co22D, stat=error ) sum_error = sum_error + error ENDIF if (activate_ocean_skin == 2) deallocate(cpl_delta_sst_2d, & cpl_delta_sal_2d, cpl_dter_2d, cpl_dser_2d, cpl_dt_ds_2d) IF (sum_error /= 0) THEN abort_message='Pb in deallocation of cpl_xxxx2D coupling variables' CALL abort_physic(modname,abort_message,1) ENDIF END SUBROUTINE cpl_send_all ! !************************************************************************************* ! SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex) USE mod_phys_lmdz_para ! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille ! 'gathered' (la grille physiq comprime). ! ! ! input: ! champ_in champ sur la grille 2D ! knon nombre de points dans le domaine a traiter ! knindex index des points de la surface a traiter ! ! output: ! champ_out champ sur la grille 'gatherd' ! USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat ! Input INTEGER, INTENT(IN) :: knon REAL, DIMENSION(nbp_lon,jj_nb), INTENT(IN) :: champ_in INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! Output REAL, DIMENSION(klon_mpi), INTENT(OUT) :: champ_out ! Local INTEGER :: i, ig REAL, DIMENSION(klon_mpi) :: temp_mpi REAL, DIMENSION(klon) :: temp_omp !************************************************************************************* ! ! Transform from 2 dimensions (nbp_lon,jj_nb) to 1 dimension (klon) !$OMP MASTER CALL Grid2Dto1D_mpi(champ_in,temp_mpi) !$OMP END MASTER CALL scatter_omp(temp_mpi,temp_omp) ! Compress from klon to knon DO i = 1, knon ig = knindex(i) champ_out(i) = temp_omp(ig) ENDDO END SUBROUTINE cpl2gath ! !************************************************************************************* ! SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex) USE mod_phys_lmdz_para ! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer ! au coupleur. ! ! input: ! champ_in champ sur la grille gathere ! knon nombre de points dans le domaine a traiter ! knindex index des points de la surface a traiter ! ! output: ! champ_out champ sur la grille 2D ! USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat ! Input arguments !************************************************************************************* INTEGER, INTENT(IN) :: knon REAL, DIMENSION(klon), INTENT(IN) :: champ_in INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! Output arguments !************************************************************************************* REAL, DIMENSION(nbp_lon,jj_nb), INTENT(OUT) :: champ_out ! Local variables !************************************************************************************* INTEGER :: i, ig REAL, DIMENSION(klon) :: temp_omp REAL, DIMENSION(klon_mpi) :: temp_mpi !************************************************************************************* ! Decompress from knon to klon temp_omp = 0. DO i = 1, knon ig = knindex(i) temp_omp(ig) = champ_in(i) ENDDO ! Transform from 1 dimension (klon) to 2 dimensions (nbp_lon,jj_nb) CALL gather_omp(temp_omp,temp_mpi) !$OMP MASTER CALL Grid1Dto2D_mpi(temp_mpi,champ_out) IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1) IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon) !$OMP END MASTER END SUBROUTINE gath2cpl ! !************************************************************************************* ! END MODULE cpl_mod