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 6195 – NEMO

Changeset 6195


Ignore:
Timestamp:
2015-12-31T16:59:59+01:00 (8 years ago)
Author:
frrh
Message:

Merge in medusa interface branch:
branches/UKMO/dev_r5518_medusa_cpl_rh [6168:6171]

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6194 r6195  
    5252   USE limthd_dh       ! for CALL lim_thd_snwblow 
    5353#endif 
     54#if defined key_medusa 
     55   USE trc 
     56#endif 
    5457 
    5558   IMPLICIT NONE 
    … …  
    108111   INTEGER, PARAMETER ::   jpr_grnm   = 44            ! Greenland ice mass 
    109112   INTEGER, PARAMETER ::   jpr_antm   = 45            ! Antarctic ice mass 
    110    INTEGER, PARAMETER ::   jprcv      = 45            ! total number of fields received 
     113   INTEGER, PARAMETER ::   jpr_atm_pco2 = 46          ! Incoming atm CO2 flux 
     114   INTEGER, PARAMETER ::   jpr_atm_dust = 47          ! Incoming atm aggregate dust  
     115   INTEGER, PARAMETER ::   jprcv      = 47            ! total number of fields received 
    111116 
    112117   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    … …  
    138143   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
    139144   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
    140    INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
     145   INTEGER, PARAMETER ::   jps_bio_co2 = 29           ! MEDUSA air-sea CO2 flux in 
     146   INTEGER, PARAMETER ::   jps_bio_dms = 30           ! MEDUSA DMS surface concentration in 
     147   INTEGER, PARAMETER ::   jpsnd      = 30            ! total number of fields sent 
     148 
     149   REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6      ! Coversion factor to get outgong DMS in standard units for coupling 
     150                                                 ! i.e. specifically nmol/L (= umol/m3) 
    141151 
    142152   !                                                         !!** namelist namsbc_cpl ** 
    … …  
    149159   END TYPE FLD_C 
    150160   ! Send to the atmosphere                           ! 
    151    TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
     161   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2   
     162   TYPE(FLD_C) ::   sn_snd_bio_co2, sn_snd_bio_dms                        
    152163   ! Received from the atmosphere                     ! 
    153164   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    154    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     165   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 
     166   TYPE(FLD_C) ::   sn_rcv_atm_pco2, sn_rcv_atm_dust                          
    155167   ! Other namelist parameters                        ! 
    156168   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    … …  
    220232      !! 
    221233      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick , sn_snd_crt   , sn_snd_co2,     & 
     234         &                  sn_snd_bio_co2, sn_snd_bio_dms,                                           & 
    222235         &                  sn_snd_cond, sn_snd_mpnd  , sn_snd_sstfrz, sn_snd_thick1,                 & 
    223236         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau   , sn_rcv_dqnsdt, sn_rcv_qsr,     & 
    224237         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf   , sn_rcv_cal   , sn_rcv_iceflx,  & 
     238         &                  sn_rcv_atm_pco2, sn_rcv_atm_dust,                                         & 
    225239         &                  sn_rcv_co2 , sn_rcv_grnm  , sn_rcv_antm  , sn_rcv_ts_ice, nn_cplmodel  ,  & 
    226240         &                  ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 
    227241         &                  rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 
     242 
    228243      !!--------------------------------------------------------------------- 
    229244      ! 
    … …  
    251266      ENDIF 
    252267      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    253          WRITE(numout,*)'  received fields (mutiple ice categogies)' 
     268         WRITE(numout,*)'  received fields (mutiple ice categories)' 
    254269         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
    255270         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 
    … …  
    266281         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    267282         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     283         WRITE(numout,*)'      atm pco2                        = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 
     284         WRITE(numout,*)'      atm dust                        = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 
    268285         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    269286         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
    … …  
    275292         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    276293         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     294         WRITE(numout,*)'      bio co2 flux                    = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 
     295         WRITE(numout,*)'      bio dms flux                    = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 
    277296         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    278297         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    … …  
    484503      !                                                      ! ------------------------- ! 
    485504      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
     505 
     506 
     507      !                                                      ! --------------------------------------- !     
     508      !                                                      ! Incoming CO2 and DUST fluxes for MEDUSA ! 
     509      !                                                      ! --------------------------------------- !   
     510      srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 
     511 
     512      IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 
     513        srcv(jpr_atm_pco2)%laction = .TRUE. 
     514      END IF 
     515                
     516      srcv(jpr_atm_dust)%clname = 'OATMDUST'    
     517      IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled')  THEN 
     518        srcv(jpr_atm_dust)%laction = .TRUE. 
     519      END IF 
     520     
    486521      !                                                      ! ------------------------- ! 
    487522      !                                                      !   topmelt and botmelt     !    
    … …  
    893928      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 
    894929      !!---------------------------------------------------------------------- 
     930 
     931      ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 
     932      ! until we know where they need to go. 
     933      REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 
     934      REAL(wp), ALLOCATABLE :: atm_dust(:,:) 
     935 
    895936      ! 
    896937      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    … …  
    10591100      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    10601101#endif 
     1102 
     1103#if defined key_medusa 
     1104      ! RSRH Allocate temporary arrays to receive incoming fields during testing 
     1105      ALLOCATE(atm_pco2(jpi,jpj)) 
     1106      ALLOCATE(atm_dust(jpi,jpj)) 
     1107 
     1108      IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 
     1109      IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 
     1110      
     1111      ! RSRH Deallocate temporary arrays. 
     1112      DEALLOCATE(atm_pco2) 
     1113      DEALLOCATE(atm_dust) 
     1114#endif 
     1115 
     1116 
     1117 
    10611118 
    10621119      !  Fields received by SAS when OASIS coupling 
    … …  
    19752032      ! 
    19762033#endif 
     2034 
     2035 
     2036!! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 
     2037!! add soing exactely the same that CO2 fluxes 
     2038!! of PISCES 
     2039!! add CO2-MEDUSA 
     2040!! add DMS-MEDUSA 
     2041!! May add also a coupling MED-UKCA key 
     2042 
     2043      ! RSRH. We don't want to use magic numbers in the code (i.e. 98 and 221). 
     2044      ! These need moving to a parameter statement (as part of MEDUSA code) or even specifying in a namelist 
     2045      ! so the following code MUST NOT be viewed as anything more than temporary. 
     2046      IF( ssnd(jps_bio_co2)%laction )   CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 
     2047 
     2048      IF( ssnd(jps_bio_dms)%laction )  THEN 
     2049          ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 
     2050          ! the coupling space. 
     2051          ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 
     2052         CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     2053      ENDIF 
     2054 
    19772055      !                                                      ! ------------------------- ! 
    19782056      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
Note: See TracChangeset for help on using the changeset viewer.