Index: LMDZ4/branches/LMDZ4-dev/libf/phylmd/cpl_mod.F90 =================================================================== --- LMDZ4/branches/LMDZ4-dev/libf/phylmd/cpl_mod.F90 (revision 1151) +++ LMDZ4/branches/LMDZ4-dev/libf/phylmd/cpl_mod.F90 (revision 1152) @@ -51,4 +51,6 @@ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp !$OMP THREADPRIVATE(cpl_windsp) + REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co2 + !$OMP THREADPRIVATE(cpl_atm_co2) REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_tauy !$OMP THREADPRIVATE(cpl_tauy) @@ -67,5 +69,6 @@ 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) @@ -84,10 +87,7 @@ REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D !$OMP THREADPRIVATE(cpl_windsp2D) - -! variable for OPENMP parallelisation - - INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp - REAL,ALLOCATABLE,DIMENSION(:,:),SAVE :: buffer_omp - + REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co22D + !$OMP THREADPRIVATE(cpl_atm_co22D) + CONTAINS ! @@ -178,9 +178,15 @@ ALLOCATE(read_alb_sic(iim, jj_nb), stat = error) sum_error = sum_error + error - ALLOCATE(read_u0(iim, jj_nb), stat = error) sum_error = sum_error + error ALLOCATE(read_v0(iim, jj_nb), stat = error) sum_error = sum_error + error + + IF (cpl_carbon_cycle) THEN + ALLOCATE(read_co2(iim, jj_nb), stat = error) + sum_error = sum_error + error + ALLOCATE(cpl_atm_co2(klon,2), stat = error) + sum_error = sum_error + error + END IF IF (sum_error /= 0) THEN @@ -195,9 +201,4 @@ unity(ig) = ig ENDDO - -! cpl_sols = 0. ; cpl_nsol = 0. ; cpl_rain = 0. ; cpl_snow = 0. -! cpl_evap = 0. ; cpl_tsol = 0. ; cpl_fder = 0. ; cpl_albe = 0. -! cpl_taux = 0. ; cpl_tauy = 0. ; cpl_rriv2D = 0. ; cpl_rcoa2D = 0. -! cpl_rlic2D = 0. ; cpl_windsp = 0. !************************************************************************************* @@ -237,7 +238,9 @@ CALL histdef(nidct, 'tmp_lat','tmp_lat', & "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) - DO jf=1,jpflda2o1 + jpflda2o2 - CALL histdef(nidct, cl_writ(jf),cl_writ(jf), & - "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) + DO jf=1,maxsend + IF (infosend(i)%action) THEN + CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , & + "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) + ENDIF END DO CALL histend(nidct) @@ -248,7 +251,9 @@ 0,zjulian,dtime,nhoridcs,nidcs) ! no vertical axis - DO jf=1,jpfldo2a - CALL histdef(nidcs, cl_read(jf),cl_read(jf), & - "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime) + DO jf=1,maxrecv + IF (inforecv(i)%action) THEN + CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , & + "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime) + ENDIF END DO CALL histend(nidcs) @@ -256,12 +261,4 @@ ENDIF ! is_sequential - -! OPENMP Initialization - -!$OMP MASTER - ALLOCATE(knon_omp(0:omp_size-1)) - ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1)) -!$OMP END MASTER -!$OMP BARRIER END SUBROUTINE cpl_init @@ -300,5 +297,5 @@ CHARACTER(len = 80) :: abort_message REAL, DIMENSION(klon) :: read_sic1D - REAL, DIMENSION(iim,jj_nb,jpfldo2a) :: tab_read_flds + REAL, DIMENSION(iim,jj_nb,maxrecv) :: tab_read_flds REAL, DIMENSION(klon,nbsrf) :: pctsrf_old REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi @@ -329,6 +326,8 @@ ndexcs(:) = 0 itau_w = itau_phy + itime - DO i = 1, jpfldo2a - CALL histwrite(nidcs,cl_read(i),itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs) + DO i = 1, maxrecv + IF (inforecv(i)%action) THEN + CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs) + ENDIF END DO ENDIF @@ -337,8 +336,8 @@ ! Save each field in a 2D array. !$OMP MASTER - read_sst(:,:) = tab_read_flds(:,:,1) ! Sea surface temperature - read_sic(:,:) = tab_read_flds(:,:,2) ! Sea ice concentration - read_alb_sic(:,:) = tab_read_flds(:,:,3) ! Albedo at sea ice - read_sit(:,:) = tab_read_flds(:,:,4) ! Sea ice temperature + 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 !$OMP END MASTER @@ -354,12 +353,19 @@ ! Transform the currents from cartesian to spheric coordinates ! tmp_r0 should be zero - CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,5), tab_read_flds(:,:,6), tab_read_flds(:,:,7), & + CALL geo2atm(iim, 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 + ELSE read_u0(:,:) = 0. read_v0(:,:) = 0. + ENDIF + + IF (cpl_carbon_cycle) THEN +!$OMP MASTER + read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux +!$OMP END MASTER ENDIF @@ -374,4 +380,5 @@ 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)) & @@ -423,4 +430,9 @@ CALL cpl2gath(read_v0, v0_new, knon, knindex) + IF (cpl_carbon_cycle) THEN + WRITE(*,*) 'cpl_carbon_cycle TO BE DONE!!' + !! var_co2 will be a intent(out) argument + !! CALL cpl2gath(read_co2, var_co2, knon, knindex) + END IF !************************************************************************************* ! The fields received from the coupler have to be weighted with the fraction of ocean @@ -519,4 +531,5 @@ CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields' CHARACTER(len = 80) :: abort_message + REAL, DIMENSION(klon) :: atm_co2 ! JG: to be an INTENT(IN) if cpl_carbon_cycle !************************************************************************************* @@ -543,4 +556,5 @@ cpl_tauy(1:knon,cpl_index) = 0.0 cpl_windsp(1:knon,cpl_index) = 0.0 + IF (cpl_carbon_cycle) cpl_atm_co2(1:knon,cpl_index) = 0.0 ENDIF @@ -572,5 +586,11 @@ cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + & windsp(ig) / FLOAT(nexca) - ENDDO + + IF (cpl_carbon_cycle) THEN + atm_co2=286. + cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + & + atm_co2(ig)/ FLOAT(nexca) + END IF + ENDDO !************************************************************************************* @@ -607,4 +627,9 @@ sum_error = sum_error + error + IF (cpl_carbon_cycle) THEN + ALLOCATE(cpl_atm_co22D(iim,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' @@ -650,5 +675,7 @@ knon, knindex) - ENDIF + IF (cpl_carbon_cycle) & + CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex) + ENDIF END SUBROUTINE cpl_send_ocean_fields @@ -775,5 +802,10 @@ ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error) sum_error = sum_error + error - + + IF (cpl_carbon_cycle) THEN + ALLOCATE(cpl_atm_co22D(iim,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' @@ -979,5 +1011,5 @@ REAL, DIMENSION(iim, jj_nb) :: tmp_calv ! Table with all fields to send to coupler - REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2) :: tab_flds + REAL, DIMENSION(iim, jj_nb, maxsend) :: tab_flds REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi @@ -998,18 +1030,19 @@ !************************************************************************************* !$OMP MASTER - tab_flds(:,:,7) = cpl_windsp2D(:,:) - tab_flds(:,:,8) = cpl_sols2D(:,:,2) - tab_flds(:,:,10) = cpl_nsol2D(:,:,2) - tab_flds(:,:,12) = cpl_fder2D(:,:,2) + 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) IF (version_ocean=='nemo') THEN - tab_flds(:,:,18) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:) + tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:) + IF (cpl_carbon_cycle) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:) ELSE IF (version_ocean=='opa8') THEN - tab_flds(:,:,9) = cpl_sols2D(:,:,1) - tab_flds(:,:,11) = cpl_nsol2D(:,:,1) - tab_flds(:,:,13) = cpl_evap2D(:,:,2) - tab_flds(:,:,14) = cpl_evap2D(:,:,1) - tab_flds(:,:,17) = cpl_rcoa2D(:,:) - tab_flds(:,:,18) = cpl_rriv2D(:,:) + 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(:,:) END IF @@ -1063,9 +1096,5 @@ ENDIF - IF (version_ocean=='nemo') THEN - tab_flds(:,:,17) = tmp_calv(:,:) - ELSE IF (version_ocean=='opa8') THEN - tab_flds(:,:,19) = tmp_calv(:,:) - END IF + tab_flds(:,:,ids_calvin) = tmp_calv(:,:) !************************************************************************************* @@ -1078,9 +1107,9 @@ IF (version_ocean=='nemo') THEN - tab_flds(:,:,9) = 0.0 - tab_flds(:,:,11) = 0.0 - tab_flds(:,:,13) = 0.0 - tab_flds(:,:,14) = 0.0 - tab_flds(:,:,15) = 0.0 + 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 tmp_taux(:,:) = 0.0 @@ -1093,29 +1122,29 @@ cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) - tab_flds(:,:,9) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) - tab_flds(:,:,11) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) - tab_flds(:,:,13) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) - tab_flds(:,:,14) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) - tab_flds(:,:,15) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) ENDWHERE - tab_flds(:,:,16) = cpl_evap2D(:,:,2) + 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(:,:,15) = 0.0 - tab_flds(:,:,16) = 0.0 + 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(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) - tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & + tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) @@ -1163,9 +1192,9 @@ !$OMP MASTER CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, & - tab_flds(:,:,1), tab_flds(:,:,2), tab_flds(:,:,3) ) - - tab_flds(:,:,4) = tab_flds(:,:,1) - tab_flds(:,:,5) = tab_flds(:,:,2) - tab_flds(:,:,6) = tab_flds(:,:,3) + 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 @@ -1175,27 +1204,9 @@ !************************************************************************************* IF (is_sequential) THEN - CALL histwrite(nidct,cl_writ(8), itau_w,tab_flds(:,:,8), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(9), itau_w,tab_flds(:,:,9), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(10),itau_w,tab_flds(:,:,10),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(11),itau_w,tab_flds(:,:,11),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(12),itau_w,tab_flds(:,:,12),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(13),itau_w,tab_flds(:,:,13),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(14),itau_w,tab_flds(:,:,14),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(15),itau_w,tab_flds(:,:,15),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(16),itau_w,tab_flds(:,:,16),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(17),itau_w,tab_flds(:,:,17),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(18),itau_w,tab_flds(:,:,18),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(19),itau_w,tab_flds(:,:,19),iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(1), itau_w,tab_flds(:,:,1), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(2), itau_w,tab_flds(:,:,2), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(3), itau_w,tab_flds(:,:,3), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(4), itau_w,tab_flds(:,:,4), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(5), itau_w,tab_flds(:,:,5), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(6), itau_w,tab_flds(:,:,6), iim*(jjm+1),ndexct) - CALL histwrite(nidct,cl_writ(7), itau_w,tab_flds(:,:,7), iim*(jjm+1),ndexct) - CALL histsync(nidct) + DO j=1,maxsend + IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, & + tab_flds(:,:,j),iim*(jjm+1),ndexct) + ENDDO ENDIF - - !************************************************************************************* ! Send the table of all fields @@ -1220,4 +1231,10 @@ DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, stat=error ) sum_error = sum_error + error + + IF (cpl_carbon_cycle) THEN + DEALLOCATE(cpl_atm_co22D, stat=error ) + sum_error = sum_error + error + END IF + IF (sum_error /= 0) THEN abort_message='Pb in deallocation of cpl_xxxx2D coupling variables' Index: LMDZ4/branches/LMDZ4-dev/libf/phylmd/oasis.F90 =================================================================== --- LMDZ4/branches/LMDZ4-dev/libf/phylmd/oasis.F90 (revision 1151) +++ LMDZ4/branches/LMDZ4-dev/libf/phylmd/oasis.F90 (revision 1152) @@ -22,25 +22,55 @@ IMPLICIT NONE - -! Maximum number of fields exchanged between ocean and atmosphere - INTEGER, PARAMETER :: jpmaxfld=40 -! Number of fields exchanged from atmosphere to ocean via flx.F - INTEGER, PARAMETER :: jpflda2o1=13 -! Number of fields exchanged from atmosphere to ocean via tau.F - INTEGER, PARAMETER :: jpflda2o2=6 -! Number of fields exchanged from ocean to atmosphere - INTEGER :: jpfldo2a - - CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE :: cl_read - !$OMP THREADPRIVATE(cl_read) - CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE :: cl_writ - !$OMP THREADPRIVATE(cl_writ) - - INTEGER, DIMENSION(jpmaxfld), SAVE, PRIVATE :: in_var_id - !$OMP THREADPRIVATE(in_var_id) - INTEGER, DIMENSION(jpflda2o1+jpflda2o2), SAVE, PRIVATE :: out_var_id - !$OMP THREADPRIVATE(out_var_id) - + + ! Id for fields sent to ocean + INTEGER, PARAMETER :: ids_tauxxu = 1 + INTEGER, PARAMETER :: ids_tauyyu = 2 + INTEGER, PARAMETER :: ids_tauzzu = 3 + INTEGER, PARAMETER :: ids_tauxxv = 4 + INTEGER, PARAMETER :: ids_tauyyv = 5 + INTEGER, PARAMETER :: ids_tauzzv = 6 + INTEGER, PARAMETER :: ids_windsp = 7 + INTEGER, PARAMETER :: ids_shfice = 8 + INTEGER, PARAMETER :: ids_shfoce = 9 + INTEGER, PARAMETER :: ids_shftot = 10 + INTEGER, PARAMETER :: ids_nsfice = 11 + INTEGER, PARAMETER :: ids_nsfoce = 12 + INTEGER, PARAMETER :: ids_nsftot = 13 + INTEGER, PARAMETER :: ids_dflxdt = 14 + INTEGER, PARAMETER :: ids_totrai = 15 + INTEGER, PARAMETER :: ids_totsno = 16 + INTEGER, PARAMETER :: ids_toteva = 17 + INTEGER, PARAMETER :: ids_icevap = 18 + INTEGER, PARAMETER :: ids_ocevap = 19 + INTEGER, PARAMETER :: ids_calvin = 20 + INTEGER, PARAMETER :: ids_liqrun = 21 + INTEGER, PARAMETER :: ids_runcoa = 22 + INTEGER, PARAMETER :: ids_rivflu = 23 + INTEGER, PARAMETER :: ids_atmco2 = 24 + INTEGER, PARAMETER :: maxsend = 24 ! Maximum number of fields to send + + ! Id for fields received from ocean + INTEGER, PARAMETER :: idr_sisutw = 1 + INTEGER, PARAMETER :: idr_icecov = 2 + INTEGER, PARAMETER :: idr_icealw = 3 + INTEGER, PARAMETER :: idr_icetem = 4 + INTEGER, PARAMETER :: idr_curenx = 5 + INTEGER, PARAMETER :: idr_cureny = 6 + INTEGER, PARAMETER :: idr_curenz = 7 + INTEGER, PARAMETER :: idr_oceco2 = 8 + INTEGER, PARAMETER :: maxrecv = 8 ! Maximum number of fields to receive + + + TYPE, PUBLIC :: FLD_CPL ! Type for coupling field information + CHARACTER(len = 8) :: name ! Name of the coupling field + LOGICAL :: action ! To be exchanged or not + INTEGER :: nid ! Id of the field + END TYPE FLD_CPL + + TYPE(FLD_CPL), DIMENSION(maxsend), PUBLIC :: infosend ! Information for sending coupling fields + TYPE(FLD_CPL), DIMENSION(maxrecv), PUBLIC :: inforecv ! Information for receiving coupling fields + LOGICAL :: cpl_current + LOGICAL :: cpl_carbon_cycle #ifdef CPP_COUPLE @@ -59,4 +89,5 @@ USE surface_data, ONLY : version_ocean INCLUDE "dimensions.h" + INCLUDE "iniprint.h" ! Local variables @@ -69,5 +100,4 @@ INTEGER, DIMENSION(4) :: il_var_actual_shape INTEGER :: il_var_type - INTEGER :: nuout = 6 INTEGER :: jf CHARACTER (len = 6) :: clmodnam @@ -75,14 +105,15 @@ CHARACTER (len = 80) :: abort_message LOGICAL :: cpl_current_omp + LOGICAL :: cpl_carbon_cycle_omp !* 1. Initializations ! --------------- !************************************************************************************ - WRITE(nuout,*) ' ' - WRITE(nuout,*) ' ' - WRITE(nuout,*) ' ROUTINE INICMA' - WRITE(nuout,*) ' **************' - WRITE(nuout,*) ' ' - WRITE(nuout,*) ' ' + WRITE(lunout,*) ' ' + WRITE(lunout,*) ' ' + WRITE(lunout,*) ' ROUTINE INICMA' + WRITE(lunout,*) ' **************' + WRITE(lunout,*) ' ' + WRITE(lunout,*) ' ' ! @@ -90,4 +121,5 @@ ! clmodnam = 'lmdz.x' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp + !************************************************************************************ @@ -100,11 +132,80 @@ !$OMP BARRIER cpl_current = cpl_current_omp - WRITE(nuout,*) 'Couple ocean currents, cpl_current = ',cpl_current - - IF (cpl_current) THEN - jpfldo2a=7 - ELSE - jpfldo2a=4 - END IF + WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current + +!************************************************************************************ +! Define if coupling carbon cycle or not +!************************************************************************************ +!$OMP MASTER + cpl_carbon_cycle_omp = .FALSE. + CALL getin('cpl_carbon_cycle', cpl_carbon_cycle_omp) +!$OMP END MASTER +!$OMP BARRIER + cpl_carbon_cycle=cpl_carbon_cycle_omp + WRITE(lunout,*) 'Couple carbon cycle , cpl_carbon_cycle = ',cpl_carbon_cycle + +!************************************************************************************ +! Define coupling variables +!************************************************************************************ + +! Atmospheric variables to send + + infosend(:)%action = .FALSE. + + infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU' + infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU' + infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU' + infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV' + infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV' + infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV' + infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP' + infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE' + infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE' + infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT' + infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN' + + + IF (version_ocean=='nemo') THEN + infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX' + infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX' + infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI' + infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO' + infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA' + infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP' + infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN' + IF (cpl_carbon_cycle) THEN + infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2' + ENDIF + + ELSE IF (version_ocean=='opa8') THEN + infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE' + infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE' + infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE' + infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE' + infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU' + infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU' + infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA' + infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU' + ENDIF + +! Oceanic variables to receive + + inforecv(:)%action = .FALSE. + + inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW' + inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV' + inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW' + inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW' + + IF (cpl_current ) THEN + inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX' + inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY' + inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ' + ENDIF + + IF (cpl_carbon_cycle ) THEN + inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX' + ENDIF + !************************************************************************************ ! Here we go: psmile initialisation @@ -117,5 +218,5 @@ CALL abort_gcm(modname,abort_message,1) ELSE - WRITE(nuout,*) 'inicma : init psmile ok ' + WRITE(lunout,*) 'inicma : init psmile ok ' ENDIF ENDIF @@ -130,5 +231,5 @@ IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+iim-1 - WRITE(nuout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3) + WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3) ierror=PRISM_Ok @@ -139,65 +240,6 @@ CALL abort_gcm(modname,abort_message,1) ELSE - WRITE(nuout,*) 'inicma : decomposition domaine psmile ok ' - ENDIF - -!************************************************************************************ -! Field Declarations -!************************************************************************************ -! Define symbolic name for fields exchanged from atmos to coupler, -! must be the same as (1) of the field definition in namcouple: -! -! Initialization - cl_writ(:)='NOFLDATM' - - cl_writ(1)='COTAUXXU' - cl_writ(2)='COTAUYYU' - cl_writ(3)='COTAUZZU' - cl_writ(4)='COTAUXXV' - cl_writ(5)='COTAUYYV' - cl_writ(6)='COTAUZZV' - cl_writ(7)='COWINDSP' - cl_writ(8)='COSHFICE' - cl_writ(10)='CONSFICE' - cl_writ(12)='CODFLXDT' - - IF (version_ocean=='nemo') THEN - cl_writ(9)='COQSRMIX' - cl_writ(11)='COQNSMIX' - cl_writ(13)='COTOTRAI' - cl_writ(14)='COTOTSNO' - cl_writ(15)='COTOTEVA' - cl_writ(16)='COICEVAP' - cl_writ(17)='COCALVIN' - cl_writ(18)='COLIQRUN' - ELSE IF (version_ocean=='opa8') THEN - cl_writ(9)='COSHFOCE' - cl_writ(11)='CONSFOCE' - cl_writ(13)='COTFSICE' - cl_writ(14)='COTFSOCE' - cl_writ(15)='COTOLPSU' - cl_writ(16)='COTOSPSU' - cl_writ(17)='CORUNCOA' - cl_writ(18)='CORIVFLU' - cl_writ(19)='COCALVIN' - ENDIF - -! -! Define symbolic name for fields exchanged from coupler to atmosphere, -! must be the same as (2) of the field definition in namcouple: -! -! Initialization - cl_read(:)='NOFLDATM' - - cl_read(1)='SISUTESW' - cl_read(2)='SIICECOV' - cl_read(3)='SIICEALW' - cl_read(4)='SIICTEMW' - - IF (cpl_current) THEN - cl_read(5)='CURRENTX' - cl_read(6)='CURRENTY' - cl_read(7)='CURRENTZ' - END IF + WRITE(lunout,*) 'inicma : decomposition domaine psmile ok ' + ENDIF il_var_nodims(1) = 2 @@ -212,29 +254,39 @@ !************************************************************************************ -! Oceanic Fields -!************************************************************************************ - DO jf=1, jpfldo2a - CALL prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, & - il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, & - ierror) - IF (ierror .NE. PRISM_Ok) THEN - abort_message=' Probleme init dans prism_def_var_proto ' - CALL abort_gcm(modname,abort_message,1) +! Oceanic Fields to receive +! Loop over all possible variables +!************************************************************************************ + DO jf=1, maxrecv + IF (inforecv(jf)%action) THEN + CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, & + il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, & + ierror) + IF (ierror .NE. PRISM_Ok) THEN + WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',& + inforecv(jf)%name + abort_message=' Problem in call to prism_def_var_proto for fields to receive' + CALL abort_gcm(modname,abort_message,1) + ENDIF ENDIF END DO - -!************************************************************************************ -! Atmospheric Fields -!************************************************************************************ - DO jf=1, jpflda2o1+jpflda2o2 - CALL prism_def_var_proto(out_var_id(jf), cl_writ(jf), il_part_id, & - il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, & - ierror) - IF (ierror .NE. PRISM_Ok) THEN - abort_message=' Probleme init dans prism_def_var_proto ' - CALL abort_gcm(modname,abort_message,1) + +!************************************************************************************ +! Atmospheric Fields to send +! Loop over all possible variables +!************************************************************************************ + DO jf=1,maxsend + IF (infosend(jf)%action) THEN + CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, & + il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, & + ierror) + IF (ierror .NE. PRISM_Ok) THEN + WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',& + infosend(jf)%name + abort_message=' Problem in call to prism_def_var_proto for fields to send' + CALL abort_gcm(modname,abort_message,1) + ENDIF ENDIF END DO - + !************************************************************************************ ! End definition @@ -242,8 +294,8 @@ CALL prism_enddef_proto(ierror) IF (ierror .NE. PRISM_Ok) THEN - abort_message=' Probleme init dans prism_ endef_proto' + abort_message=' Problem in call to prism_endef_proto' CALL abort_gcm(modname,abort_message,1) ELSE - WRITE(nuout,*) 'inicma : endef psmile ok ' + WRITE(lunout,*) 'inicma : endef psmile ok ' ENDIF @@ -261,4 +313,5 @@ ! INCLUDE "dimensions.h" + INCLUDE "iniprint.h" ! Input arguments !************************************************************************************ @@ -267,9 +320,8 @@ ! Output arguments !************************************************************************************ - REAL, DIMENSION(iim, jj_nb,jpfldo2a), INTENT(OUT) :: tab_get + REAL, DIMENSION(iim, jj_nb,maxrecv), INTENT(OUT) :: tab_get ! Local variables !************************************************************************************ - INTEGER :: nuout = 6 ! listing output unit INTEGER :: ierror, i INTEGER :: istart,iend @@ -279,7 +331,7 @@ !************************************************************************************ - WRITE (nuout,*) ' ' - WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime - WRITE (nuout,*) ' ' + WRITE (lunout,*) ' ' + WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime + WRITE (lunout,*) ' ' istart=ii_begin @@ -290,17 +342,19 @@ ENDIF - DO i = 1, jpfldo2a - field(:) = -99999. - CALL prism_get_proto(in_var_id(i), ktime, field(istart:iend), ierror) - tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/)) + DO i = 1, maxrecv + IF (inforecv(i)%action) THEN + field(:) = -99999. + CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror) + tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/)) - IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. & - ierror.NE.PRISM_FromRest & - .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut & - .AND. ierror.NE.PRISM_FromRestOut) THEN - WRITE (nuout,*) cl_read(i), ktime - abort_message=' Probleme dans prism_get_proto ' - CALL abort_gcm(modname,abort_message,1) - ENDIF + IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. & + ierror.NE.PRISM_FromRest & + .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut & + .AND. ierror.NE.PRISM_FromRestOut) THEN + WRITE (lunout,*) 'Error with receiving filed : ', inforecv(i)%name, ktime + abort_message=' Problem in prism_get_proto ' + CALL abort_gcm(modname,abort_message,1) + ENDIF + ENDIF END DO @@ -321,9 +375,10 @@ ! INCLUDE "dimensions.h" + INCLUDE "iniprint.h" ! Input arguments !************************************************************************************ - INTEGER, INTENT(IN) :: ktime - LOGICAL, INTENT(IN) :: last - REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2), INTENT(IN) :: tab_put + INTEGER, INTENT(IN) :: ktime + LOGICAL, INTENT(IN) :: last + REAL, DIMENSION(iim, jj_nb, maxsend), INTENT(IN) :: tab_put ! Local variables @@ -332,5 +387,4 @@ INTEGER :: istart,iend INTEGER :: wstart,wend - INTEGER, PARAMETER :: nuout = 6 INTEGER :: ierror, i REAL, DIMENSION(iim*jj_nb) :: field @@ -341,8 +395,8 @@ checkout=.FALSE. - WRITE(nuout,*) ' ' - WRITE(nuout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime - WRITE(nuout,*) 'last ', last - WRITE(nuout,*) + WRITE(lunout,*) ' ' + WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime + WRITE(lunout,*) 'last = ', last + WRITE(lunout,*) @@ -360,60 +414,29 @@ IF (is_south_pole) wend=iend-iim+1 - field = RESHAPE(tab_put(:,:,8),(/iim*jj_nb/)) - CALL writeField_phy("fsolice",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,9),(/iim*jj_nb/)) - CALL writeField_phy("fsolwat",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,10),(/iim*jj_nb/)) - CALL writeField_phy("fnsolice",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,11),(/iim*jj_nb/)) - CALL writeField_phy("fnsolwat",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,12),(/iim*jj_nb/)) - CALL writeField_phy("fnsicedt",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,13),(/iim*jj_nb/)) - CALL writeField_phy("evice",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,14),(/iim*jj_nb/)) - CALL writeField_phy("evwat",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,15),(/iim*jj_nb/)) - CALL writeField_phy("lpre",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,16),(/iim*jj_nb/)) - CALL writeField_phy("spre",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,17),(/iim*jj_nb/)) - CALL writeField_phy("dirunoff",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,18),(/iim*jj_nb/)) - CALL writeField_phy("rivrunoff",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,19),(/iim*jj_nb/)) - CALL writeField_phy("calving",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,1),(/iim*jj_nb/)) - CALL writeField_phy("tauxx_u",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,2),(/iim*jj_nb/)) - CALL writeField_phy("tauyy_u",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,3),(/iim*jj_nb/)) - CALL writeField_phy("tauzz_u",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,4),(/iim*jj_nb/)) - CALL writeField_phy("tauxx_v",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,5),(/iim*jj_nb/)) - CALL writeField_phy("tauyy_v",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,6),(/iim*jj_nb/)) - CALL writeField_phy("tauzz_v",field(wstart:wend),1) - field = RESHAPE(tab_put(:,:,7),(/iim*jj_nb/)) - CALL writeField_phy("windsp",field(wstart:wend),1) - ENDIF - + DO i = 1, maxsend + IF (infosend(i)%action) THEN + field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/)) + CALL writefield_phy(infosend(i)%name,field(wstart:wend),1) + END IF + END DO + END IF + !************************************************************************************ ! PRISM_PUT !************************************************************************************ - DO i = 1, jpflda2o1+jpflda2o2 - field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/)) - CALL prism_put_proto(out_var_id(i), ktime, field(istart:iend), ierror) - - IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest & - .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. & - ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN - WRITE (nuout,*) cl_writ(i), ktime - abort_message=' Probleme dans prism_put_proto ' - CALL abort_gcm(modname,abort_message,1) - ENDIF - + DO i = 1, maxsend + IF (infosend(i)%action) THEN + field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/)) + CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror) + + IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest & + .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. & + ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN + WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime + abort_message=' Problem in prism_put_proto ' + CALL abort_gcm(modname,abort_message,1) + ENDIF + ENDIF END DO @@ -427,5 +450,5 @@ CALL prism_terminate_proto(ierror) IF (ierror .NE. PRISM_Ok) THEN - abort_message=' Probleme dans prism_terminate_proto ' + abort_message=' Problem in prism_terminate_proto ' CALL abort_gcm(modname,abort_message,1) ENDIF