New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6744 for branches/NERC – NEMO

Changeset 6744 for branches/NERC


Ignore:
Timestamp:
2016-06-27T18:21:18+02:00 (8 years ago)
Author:
jpalmier
Message:

JPALM --27-06-2016 -- Update MEDUSA-atm coupling

Location:
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r5735 r6744  
    7272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    7373 
     74!! Arrays used in coupling when MEDUSA is present. These arrays need to be declared 
     75!! even if MEDUSA is not active, to allow compilation, in which case they will not be allocated. 
     76!! --------------------- 
     77REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: CO2Flux_out_cpl(:,:)   ! Output coupling CO2 flux  
     78REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: DMS_out_cpl(:,:)       ! Output coupling DMS  
     79REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: PCO2a_in_cpl(:,:)      ! Input coupling CO2 partial pressure 
     80REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: Dust_in_cpl(:,:)       ! Input coupling dust 
     81 
     82#if defined key_medusa 
     83LOGICAL, PUBLIC, PARAMETER :: ln_medusa=.TRUE.                ! Medusa switched on or off. 
     84#else 
     85LOGICAL, PUBLIC, PARAMETER :: ln_medusa=.FALSE.               ! Medusa switched on or off. 
     86#endif 
    7487   !!---------------------------------------------------------------------- 
    7588   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    119132      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 
    120133         ! 
     134#if defined key_oasis3 
     135      IF (ln_medusa) THEN 
     136         ! We only actually need these arrays to be allocated if coupling and MEDUSA 
     137         ! are enabled 
     138         ALLOCATE( CO2Flux_out_cpl(jpi,jpj),DMS_out_cpl(jpi,jpj),               & 
     139                   PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj),    STAT=ierr(5) ) 
     140 
     141         ! RSRH Temporarily initialise output coupling fields while we await clarification 
     142         ! of exactly how these will be initialised at model startup! 
     143         DMS_out_cpl(:,:) = 0.0 
     144         CO2Flux_out_cpl(:,:) = 0.0 
     145      ENDIF 
     146#endif 
    121147      oce_alloc = MAXVAL( ierr ) 
    122148      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays') 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r6715 r6744  
    9191      USE, INTRINSIC :: ieee_arithmetic  
    9292 
     93      !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm 
     94      USE sbc_oce, ONLY: lk_oasis 
     95      USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl 
     96 
    9397      IMPLICIT NONE 
    9498      PRIVATE 
     
    320324      !! AXY (13/03/15): add in other DMS calculations 
    321325      REAL(wp) ::    dms_andr, dms_simo, dms_aran, dms_hall 
    322 #  if defined key_oasis3 
    323       REAL(wp), DIMENSION(jpi,jpj) :: pco2a_2d(ji,jj)        !! use 2D atm pCO2 from atm coupling 
    324 #  endif 
    325326 
    326327# endif 
     
    10511052                  !! OPEN wet point IF..THEN loop 
    10521053                  if (tmask(ji,jj,jk).eq.1) then 
    1053 #  if defined key_oasis3 
    1054                      f_pco2a = pco2a_2d(ji,jj)        !! use 2D atm pCO2 from atm coupling 
    1055 #  endif 
     1054                     IF (lk_oasis) THEN 
     1055                        f_pco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm pCO2 from atm coupling 
     1056                     ENDIF 
    10561057                     !! do carbonate chemistry 
    10571058                     !! 
     
    13831384                  !! 
    13841385                  f_wind  = wndm(ji,jj) 
    1385 #  if defined key_oasis3 
    1386                   f_pco2a = pco2a_2d(ji,jj)        !! use 2D atm pCO2 from atm coupling 
    1387 #  endif 
    1388  
     1386                  IF (lk_oasis) THEN 
     1387                     f_pco2a = PCO2a_in_cpl(ji,jj)        !! use 2D atm pCO2 from atm coupling 
     1388                  ENDIF 
    13891389                  !! 
    13901390                  !! AXY (23/06/15): as part of an effort to update the carbonate chemistry 
     
    43564356                     ENDIF 
    43574357                     IF( med_diag%CO2FLUX%dgsave ) THEN 
     4358                         CALL lbc_lnk(f_co2flux2d(:,:),'T',1. ) 
    43584359                         CALL iom_put( "CO2FLUX"  , f_co2flux2d ) 
    43594360                         zb_co2_flx = zn_co2_flx 
    43604361                         zn_co2_flx = f_co2flux2d 
     4362                         IF (lk_oasis) THEN 
     4363                            CO2Flux_out_cpl = zn_co2_flx 
     4364                         ENDIF 
    43614365                         CALL wrk_dealloc( jpi, jpj,   f_co2flux2d   ) 
    43624366                     ENDIF 
     
    43994403                     IF (jdms .eq. 1) THEN 
    44004404                       IF( med_diag%DMS_SURF%dgsave ) THEN 
     4405                         CALL lbc_lnk(dms_surf2d(:,:),'T',1. ) 
    44014406                         CALL iom_put( "DMS_SURF"  , dms_surf2d ) 
    44024407                         zb_dms_srf = zn_dms_srf 
    44034408                         zn_dms_srf = dms_surf2d 
     4409                         IF (lk_oasis) THEN 
     4410                            DMS_out_cpl = zn_dms_srf 
     4411                         ENDIF 
    44044412                         CALL wrk_dealloc( jpi, jpj,   dms_surf2d   )  
    44054413                       ENDIF 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90

    r6466 r6744  
    2828   USE lbclnk 
    2929   USE prtctl_trc      ! Print control for debbuging 
     30   !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm 
     31   USE sbc_oce, ONLY: lk_oasis 
     32   USE oce,     ONLY: Dust_in_cpl 
     33 
    3034 
    3135   IMPLICIT NONE 
     
    147151            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
    148152         ENDIF 
     153      ELSEIF (lk_oasis) THEN 
     154         dust = Dust_in_cpl 
    149155      ELSE 
    150156         dust(:,:) = 0.0 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r6715 r6744  
    4141#endif 
    4242   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE oce,    ONLY: CO2Flux_out_cpl, DMS_out_cpl  !! Coupling variable 
    4344 
    4445   IMPLICIT NONE 
     
    251252         zn_dms_srf(:,:)  = 0.0 
    252253      ENDIF 
     254      IF (lk_oasis) THEN 
     255         DMS_out_cpl(:,:) = zn_dms_srf(:,:)        !! Coupling variable 
     256      END IF 
    253257      !! 
    254258      IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN 
     
    261265         zn_co2_flx(:,:)  = 0.0 
    262266      ENDIF 
     267      IF (lk_oasis) THEN 
     268         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable 
     269      END IF 
    263270      !! 
    264271      !! calculate stats on these fields 
Note: See TracChangeset for help on using the changeset viewer.