Changeset 11509 for NEMO/branches/UKMO/NEMO_4.0_new_runoff_coupling/src/OCE/SBC/sbccpl.F90

Timestamp:

2019-09-06T18:07:34+02:00 (5 years ago)

Author:

dancopsey

Message:

Merge in all the 1D river runoff code as I comitted to the GO6 package branch (skipping anything to do with Antarctic and Greenland icesheet mass).

File:

• NEMO/branches/UKMO/NEMO_4.0_new_runoff_coupling/src/OCE/SBC/sbccpl.F90 (modified) (10 diffs)

NEMO/branches/UKMO/NEMO_4.0_new_runoff_coupling/src/OCE/SBC/sbccpl.F90

@@ -36 +36 @@
    USE eosbn2         ! 
    USE sbcrnf  , ONLY : l_rnfcpl
+   USE cpl_rnf_1d, ONLY: nn_cpl_river, cpl_rnf_1d_init, cpl_rnf_1d_to_2d   ! Variables used in 1D river outflow 
    USE sbcisf  , ONLY : l_isfcpl
 #if defined key_cice
@@ -116 +117 @@
    INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves
    INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp
-
-   INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received  
+   INTEGER, PARAMETER ::   jpr_rnf_1d = 58   ! 1D river runoff 
+
+   INTEGER, PARAMETER ::   jprcv      = 58   ! total number of fields received  
 
    INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
@@ -345 +347 @@
 
       ! default definitions of srcv
-      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1
+      srcv(:)%laction = .FALSE
+      srcv(:)%clgrid = 'T'
+      srcv(:)%nsgn = 1
+      srcv(:)%nct = 1
+      srcv(:)%dimensions = 2
 
       !                                                      ! ------------------------- !
@@ -461 +467 @@
       !                                                      !     Runoffs & Calving     !   
       !                                                      ! ------------------------- !
-      srcv(jpr_rnf   )%clname = 'O_Runoff'
-      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
-         srcv(jpr_rnf)%laction = .TRUE.
+      srcv(jpr_rnf_1d   )%clname = 'ORunff1D' 
+      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN  
+         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 
+         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 
+            srcv(jpr_rnf_1d)%laction = .TRUE. 
+            srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 
+         END IF
          l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf
          ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
@@ -743 +753 @@
       
       ! default definitions of nsnd
-      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1
+      ssnd(:)%laction = .FALSE.
+      ssnd(:)%clgrid = 'T'
+      ssnd(:)%nsgn = 1
+      ssnd(:)%nct = 1
+      ssnd(:)%dimensions = 2
          
       !                                                      ! ------------------------- !
@@ -1022 +1036 @@
          ENDIF
       ENDIF
+
+      ! Initialise 1D river outflow scheme 
+      nn_cpl_river = 1 
+      IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init   ! Coupled runoff using 1D array
+
+      ! =================================================== !
+      ! Allocate all parts of frcv used for received fields !
+      ! =================================================== !
+      DO jn = 1, jprcv
+
+         IF ( srcv(jn)%laction ) THEN 
+            SELECT CASE( srcv(jn)%dimensions )
+            !
+            CASE( 0 )   ! Scalar field
+               ALLOCATE( frcv(jn)%z3(1,1,1) )
+               
+            CASE( 1 )   ! 1D field
+               ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) )
+               
+            CASE DEFAULT  ! 2D (or pseudo 3D) field.
+               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
+               
+            END SELECT
+         END IF
+
+      END DO
+      ! Allocate taum part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+      ! Allocate w10m part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
+      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
+      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
+      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
+      IF( k_ice /= 0 ) THEN
+         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
+         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
+      END IF
 
       !
@@ -1118 +1170 @@
       isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges
       DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
-         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
+         IF( srcv(jn)%laction ) THEN  
+ 
+            IF ( srcv(jn)%dimensions <= 1 ) THEN 
+               CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 
+            ELSE 
+               CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
+            END IF 
+ 
+         END IF 
       END DO
 
@@ -1399 +1459 @@
          !                                                        ! runoffs and calving (added in emp)
          IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+         IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:))
          IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
  
@@ -1699 +1760 @@
          rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
       ENDIF
+      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:))
       IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce)
          zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
@@ -1739 +1801 @@
          rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
       ENDIF
+      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:))
       IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot)
          zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)