Ignore:
Timestamp:
2016-06-06T12:42:27+02:00 (4 years ago)
Author:
frrh
Message:

Add true MEDUSA fields for incoming coupling.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GSI7_GSI8_landice_bitcomp_medusa/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6659 r6668  
    5050#endif 
    5151   USE lib_fortran, ONLY: glob_sum 
     52#if defined key_medusa 
     53!   USE trc 
     54   USE trcbio_medusa, ONLY: f_co2flux2d, dms_surf2d 
     55   USE sms_medusa, ONLY: f_pco2a, dust 
     56#endif 
    5257 
    5358   IMPLICIT NONE 
     
    106111   INTEGER, PARAMETER ::   jpr_grnm   = 44            ! Greenland ice mass 
    107112   INTEGER, PARAMETER ::   jpr_antm   = 45            ! Antarctic ice mass 
    108    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 
    109116 
    110117   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
     
    142149   INTEGER, PARAMETER ::   jps_fice1  = 33            ! first-order ice concentration (for time-travelling ice coupling) 
    143150   INTEGER, PARAMETER ::   jpsnd      = 33            ! total number of fields sended 
     151   INTEGER, PARAMETER ::   jps_bio_co2 = 34           ! MEDUSA air-sea CO2 flux in 
     152   INTEGER, PARAMETER ::   jps_bio_dms = 35           ! MEDUSA DMS surface concentration in 
     153   INTEGER, PARAMETER ::   jpsnd      = 35            ! total number of fields sent 
     154 
     155   REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6      ! Coversion factor to get outgong DMS in standard units for coupling 
     156                                                 ! i.e. specifically nmol/L (= umol/m3) 
    144157 
    145158   !                                                         !!** namelist namsbc_cpl ** 
     
    153166   ! Send to the atmosphere                           ! 
    154167   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 
     168   TYPE(FLD_C) ::   sn_snd_bio_co2, sn_snd_bio_dms                        
    155169 
    156170   ! Received from the atmosphere                     ! 
    157171   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 
    158172   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 
     173   TYPE(FLD_C) ::   sn_rcv_atm_pco2, sn_rcv_atm_dust                          
     174 
    159175   ! Other namelist parameters                        ! 
    160176   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     
    231247         &                  rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 
    232248      !!--------------------------------------------------------------------- 
     249 
     250      ! Add MEDUSA related fields to namelist 
     251      NAMELIST/namsbc_cpl/  sn_snd_bio_co2, sn_snd_bio_dms,                                           & 
     252         &                  sn_rcv_atm_pco2, sn_rcv_atm_dust 
     253 
     254      !!--------------------------------------------------------------------- 
     255 
    233256      ! 
    234257      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_init') 
     
    255278      ENDIF 
    256279      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    257          WRITE(numout,*)'  received fields (mutiple ice categogies)' 
     280         WRITE(numout,*)'  received fields (mutiple ice categories)' 
    258281         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
    259282         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 
     
    272295         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    273296         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     297         WRITE(numout,*)'      atm pco2                        = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 
     298         WRITE(numout,*)'      atm dust                        = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 
    274299         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    275300         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
     
    280305         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor 
    281306         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
     307         WRITE(numout,*)'      bio co2 flux                    = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 
     308         WRITE(numout,*)'      bio dms flux                    = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 
    282309         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
    283310         WRITE(numout,*)'      ice effective conductivity      = ', TRIM(sn_snd_cond%cldes   ), ' (', TRIM(sn_snd_cond%clcat   ), ')' 
     
    495522      !                                                      ! ------------------------- ! 
    496523      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
     524 
     525 
     526      !                                                      ! --------------------------------------- !     
     527      !                                                      ! Incoming CO2 and DUST fluxes for MEDUSA ! 
     528      !                                                      ! --------------------------------------- !   
     529      srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 
     530 
     531      IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 
     532        srcv(jpr_atm_pco2)%laction = .TRUE. 
     533      END IF 
     534                
     535      srcv(jpr_atm_dust)%clname = 'OATMDUST'    
     536      IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled')  THEN 
     537        srcv(jpr_atm_dust)%laction = .TRUE. 
     538      END IF 
     539     
    497540      !                                                      ! ------------------------- ! 
    498541      !                                                      !   topmelt and botmelt     !    
     
    9911034      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    9921035      !!---------------------------------------------------------------------- 
     1036 
     1037      ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 
     1038      ! until we know where they need to go. 
     1039      REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 
     1040      REAL(wp), ALLOCATABLE :: atm_dust(:,:) 
     1041 
    9931042      ! 
    9941043      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
     
    11281177         !   
    11291178      ENDIF 
     1179 
     1180#if defined key_medusa 
     1181      ! RSRH Allocate temporary arrays to receive incoming fields during testing 
     1182      ALLOCATE(atm_pco2(jpi,jpj)) 
     1183      ALLOCATE(atm_dust(jpi,jpj)) 
     1184 
     1185      IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 
     1186      IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 
     1187      
     1188      ! RSRH Deallocate temporary arrays. 
     1189      DEALLOCATE(atm_pco2) 
     1190      DEALLOCATE(atm_dust) 
     1191#endif 
    11301192 
    11311193#if defined key_cpl_carbon_cycle 
     
    21682230      ! 
    21692231#endif 
     2232 
     2233 
     2234 
     2235#if defined key_medusa 
     2236      IF( ssnd(jps_bio_co2)%laction ) CALL cpl_prism_snd( jps_bio_co2, isec, f_co2flux2d, info ) 
     2237 
     2238      IF( ssnd(jps_bio_dms)%laction )  THEN 
     2239          ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 
     2240          ! the coupling space. 
     2241          ztmp1(:,: ) = dms_surf2d(:,:) * dms_unit_conv 
     2242         CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     2243      ENDIF 
     2244#endif 
     2245 
    21702246      !                                                      ! ------------------------- ! 
    21712247      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
Note: See TracChangeset for help on using the changeset viewer.