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 10041 for branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2018-08-07T12:17:06+02:00 (6 years ago)
Author:
dancopsey
Message:

Added coupling of 1D river outflow.

File:
1 edited

Legend:

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

    r9280 r10041  
    4646   USE eosbn2 
    4747   USE sbcrnf   , ONLY : l_rnfcpl 
     48   USE cpl_rnf_1d, ONLY: nn_cpl_river, cpl_rnf_1d_init, cpl_rnf_1d_to_2d   ! Variables used in 1D river outflow 
    4849#if defined key_cpl_carbon_cycle 
    4950   USE p4zflx, ONLY : oce_co2 
     
    111112   INTEGER, PARAMETER ::   jpr_atm_pco2 = 46          ! Incoming atm CO2 flux 
    112113   INTEGER, PARAMETER ::   jpr_atm_dust = 47          ! Incoming atm aggregate dust  
    113    INTEGER, PARAMETER ::   jprcv      = 47            ! total number of fields received 
     114   INTEGER, PARAMETER ::   jpr_rnf_1d = 48          ! Incoming atm aggregate dust  
     115   INTEGER, PARAMETER ::   jprcv      = 48            ! total number of fields received 
    114116 
    115117   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
     
    175177   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    176178                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    177    INTEGER     ::   nn_cpl_river           ! Number of rivers to be dealt with in atmos-ocean coupling.  
    178179 
    179180   TYPE ::   DYNARR      
     
    468469      !                                                      ! ------------------------- ! 
    469470      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    470       IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    471          srcv(jpr_rnf)%laction = .TRUE. 
     471      srcv(jpr_rnf_1d   )%clname = 'runoffo' 
     472      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN  
     473         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 
     474         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 
     475            srcv(jpr_rnf_1d)%laction = .TRUE. 
     476            srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 
     477         END IF 
    472478         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
    473479         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     
    673679         ENDIF 
    674680      ENDIF 
    675        
    676       ! =================================================== ! 
    677       ! Allocate all parts of frcv used for received fields ! 
    678       ! =================================================== ! 
    679       DO jn = 1, jprcv 
    680  
    681          IF ( srcv(jn)%laction ) THEN  
    682             IF ( srcv(jn)%dimensions == 0 ) THEN 
    683 WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 
    684  
    685                ! We have a scalar field 
    686                ALLOCATE( frcv(jn)%z3(1,1,1) ) 
    687             ELSE 
    688  WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 
    689               ! We have a "normal" 2D (or pseudo 3D) field. 
    690                ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    691             END IF 
    692          END IF 
    693  
    694       END DO 
    695       ! Allocate taum part of frcv which is used even when not received as coupling field 
    696       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    697       ! Allocate w10m part of frcv which is used even when not received as coupling field 
    698       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    699       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    700       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    701       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    702       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    703       IF( k_ice /= 0 ) THEN 
    704          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    705          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    706       END IF 
    707681 
    708682      ! ================================ ! 
     
    971945         ENDIF 
    972946      ENDIF 
     947       
     948      ! Initialise 1D river outflow scheme  
     949      nn_cpl_river = 1  
     950      IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init   ! Coupled runoff using 1D array 
     951 
     952      ! =================================================== ! 
     953      ! Allocate all parts of frcv used for received fields ! 
     954      ! =================================================== ! 
     955      DO jn = 1, jprcv 
     956 
     957         IF ( srcv(jn)%laction ) THEN  
     958            SELECT CASE( srcv(jn)%dimensions ) 
     959            ! 
     960            CASE( 0 )   ! Scalar field 
     961WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 
     962 
     963               ! We have a scalar field 
     964               ALLOCATE( frcv(jn)%z3(1,1,1) ) 
     965                
     966            CASE( 1 )   ! 1D field 
     967             
     968               ! In the special case of 1D fields we can't allocate the array yet as 
     969               ! we don't know what nn_cpl_river is.  
     970WRITE(numout,*) "RSRH allocate 1 dim field z3",jn, nn_cpl_river ; flush(numout) 
     971                
     972               ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 
     973                
     974            CASE DEFAULT 
     975             
     976 WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 
     977              ! We have a "normal" 2D (or pseudo 3D) field. 
     978               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     979            END SELECT 
     980         END IF 
     981 
     982      END DO 
     983      ! Allocate taum part of frcv which is used even when not received as coupling field 
     984      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     985      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     986      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     987      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     988      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     989      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     990      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
     991      IF( k_ice /= 0 ) THEN 
     992         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     993         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     994      END IF 
    973995 
    974996      ! 
     
    11071129 
    11081130            IF ( srcv(jn)%dimensions == 0 ) THEN 
    1109 write(numout,*) "RSRH recieving 0d field",kt,jn ; flush(numout) 
     1131write(numout,*) "RSRH recieving 0d or 1d field",kt,jn ; flush(numout) 
    11101132               CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 
    11111133            ELSE 
     
    14251447write(numout,*) "RSRH still in cpl_rcv inside teswt for grnm",kt ; flush(numout) 
    14261448 
    1427          zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 
    14281449         greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt          
    14291450 
     
    14601481         zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 
    14611482 
    1462          zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 
    14631483         antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt          
    14641484 
     
    18611881      ! --- runoffs (included in emp later on) --- ! 
    18621882      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1883      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    18631884 
    18641885      ! --- calving (put in emp_tot and emp_oce) --- ! 
     
    18981919      ! runoffs and calving (put in emp_tot) 
    18991920      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1921      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    19001922      IF( iom_use('hflx_rnf_cea') )   & 
    19011923         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
Note: See TracChangeset for help on using the changeset viewer.