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

Changeset 6171


Ignore:
Timestamp:
2015-12-24T17:28:53+01:00 (8 years ago)
Author:
frrh
Message:

Add MEDUSA coupling interface code. Much of this is temporary and needs further
attention, e.g. for development purposes we allocate temporarry receiving
arrays and we also currently feature the original "magic number"
approach to identifying output fields which must not be allowed to
be a permanent solution and in any case should not get past a code review.

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r6168 r6171  
    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 
    … …  
    105108   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
    106109   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     110   INTEGER, PARAMETER ::   jpr_atm_pco2 = 43          ! Incoming atm CO2 flux 
     111   INTEGER, PARAMETER ::   jpr_atm_dust = 44          ! Incoming atm aggregate dust  
     112   INTEGER, PARAMETER ::   jprcv      = 44            ! total number of fields received 
    108113 
    109114   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    … …  
    135140   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
    136141   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
    137    INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
     142   INTEGER, PARAMETER ::   jps_bio_co2 = 29           ! MEDUSA air-sea CO2 flux in 
     143   INTEGER, PARAMETER ::   jps_bio_dms = 30           ! MEDUSA DMS surface concentration in 
     144   INTEGER, PARAMETER ::   jpsnd      = 30            ! total number of fields sent 
     145 
     146   REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6      ! Coversion factor to get outgong DMS in standard units for coupling 
     147                                                 ! i.e. specifically nmol/L (= umol/m3) 
    138148 
    139149   !                                                         !!** namelist namsbc_cpl ** 
    … …  
    146156   END TYPE FLD_C 
    147157   ! Send to the atmosphere                           ! 
    148    TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
     158   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2   
     159   TYPE(FLD_C) ::   sn_snd_bio_co2, sn_snd_bio_dms                        
    149160   ! Received from the atmosphere                     ! 
    150161   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 
    151    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     162   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 
     163   TYPE(FLD_C) ::   sn_rcv_atm_pco2, sn_rcv_atm_dust                          
    152164   ! Other namelist parameters                        ! 
    153165   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    … …  
    217229      !! 
    218230      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      & 
     231         &                  sn_snd_bio_co2, sn_snd_bio_dms,                                           & 
     232         &                  sn_rcv_atm_pco2, sn_rcv_atm_dust,                                         & 
    219233         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
    220234         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
    … …  
    245259      ENDIF 
    246260      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    247          WRITE(numout,*)'  received fields (mutiple ice categogies)' 
     261         WRITE(numout,*)'  received fields (mutiple ice categories)' 
    248262         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
    249263         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 
    … …  
    260274         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    261275         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     276         WRITE(numout,*)'      atm pco2                        = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 
     277         WRITE(numout,*)'      atm dust                        = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 
    262278         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    263279         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
    … …  
    269285         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    270286         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     287         WRITE(numout,*)'      bio co2 flux                    = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 
     288         WRITE(numout,*)'      bio dms flux                    = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 
    271289         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    272290         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    … …  
    470488      !                                                      ! ------------------------- ! 
    471489      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
     490 
     491 
     492      !                                                      ! --------------------------------------- !     
     493      !                                                      ! Incoming CO2 and DUST fluxes for MEDUSA ! 
     494      !                                                      ! --------------------------------------- !   
     495      srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 
     496 
     497      IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 
     498        srcv(jpr_atm_pco2)%laction = .TRUE. 
     499      END IF 
     500                
     501      srcv(jpr_atm_dust)%clname = 'OATMDUST'    
     502      IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled')  THEN 
     503        srcv(jpr_atm_dust)%laction = .TRUE. 
     504      END IF 
     505     
    472506      !                                                      ! ------------------------- ! 
    473507      !                                                      !   topmelt and botmelt     !    
    … …  
    852886      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    853887      !!---------------------------------------------------------------------- 
     888 
     889      ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 
     890      ! until we know where they need to go. 
     891      REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 
     892      REAL(wp), ALLOCATABLE :: atm_dust(:,:) 
     893 
    854894      ! 
    855895      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    … …  
    9961036      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    9971037#endif 
     1038 
     1039#if defined key_medusa 
     1040      ! RSRH Allocate temporary arrays to receive incoming fields during testing 
     1041      ALLOCATE(atm_pco2(jpi,jpj)) 
     1042      ALLOCATE(atm_dust(jpi,jpj)) 
     1043 
     1044      IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 
     1045      IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 
     1046      
     1047      ! RSRH Deallocate temporary arrays. 
     1048      DEALLOCATE(atm_pco2) 
     1049      DEALLOCATE(atm_dust) 
     1050#endif 
     1051 
     1052 
     1053 
    9981054 
    9991055      !  Fields received by SAS when OASIS coupling 
    … …  
    18521908      ! 
    18531909#endif 
     1910 
     1911 
     1912!! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 
     1913!! add soing exactely the same that CO2 fluxes 
     1914!! of PISCES 
     1915!! add CO2-MEDUSA 
     1916!! add DMS-MEDUSA 
     1917!! May add also a coupling MED-UKCA key 
     1918 
     1919      ! RSRH. We don't want to use magic numbers in the code (i.e. 98 and 221). 
     1920      ! These need moving to a parameter statement (as part of MEDUSA code) or even specifying in a namelist 
     1921      ! so the following code MUST NOT be viewed as anything more than temporary. 
     1922      IF( ssnd(jps_bio_co2)%laction )   CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 
     1923 
     1924      IF( ssnd(jps_bio_dms)%laction )  THEN 
     1925          ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 
     1926          ! the coupling space. 
     1927          ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 
     1928         CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1929      ENDIF 
     1930 
    18541931      !                                                      ! ------------------------- ! 
    18551932      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
Note: See TracChangeset for help on using the changeset viewer.