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 10269 for branches/UKMO – NEMO

Changeset 10269 for branches/UKMO


Ignore:
Timestamp:
2018-11-01T11:35:45+01:00 (5 years ago)
Author:
frrh
Message:

Merged Dan's runoff and 0d field coupling chnages from
branches/UKMO/dev_r5518_GO6_new_runoff_coupling using command:

svn merge -r 10174:10215 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/UKMO/dev_r5518_GO6_new_runoff_coupling

Location:
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
2 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r10159 r10269  
    2828#endif 
    2929   USE par_oce                      ! ocean parameters 
     30   USE cpl_rnf_1d, ONLY: nn_cpl_river   ! Variables used in 1D river outflow 
    3031   USE dom_oce                      ! ocean space and time domain 
    3132   USE in_out_manager               ! I/O manager 
     
    3435   IMPLICIT NONE 
    3536   PRIVATE 
     37    
     38#if ! defined key_oasis3 
     39   ! Dummy interface to oasis_get if not using oasis 
     40   INTERFACE oasis_get 
     41      MODULE PROCEDURE oasis_get_1d, oasis_get_2d 
     42   END INTERFACE 
     43#endif 
    3644 
    3745   PUBLIC   cpl_init 
     
    3947   PUBLIC   cpl_snd 
    4048   PUBLIC   cpl_rcv 
     49   PUBLIC   cpl_rcv_1d 
    4150   PUBLIC   cpl_freq 
    4251   PUBLIC   cpl_finalize 
     
    8897      INTEGER               ::   nct       ! Number of categories in field 
    8998      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
     99      INTEGER               ::   dimensions ! Number of dimensions of coupling field 
    90100   END TYPE FLD_CPL 
    91101 
     
    150160      ! 
    151161      INTEGER :: id_part 
     162      INTEGER :: id_part_0d     ! Partition for 0d fields 
     163      INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 
     164      INTEGER :: id_part_temp   ! Temperary partition used to choose either 0d or 1d partitions 
    152165      INTEGER :: paral(5)       ! OASIS3 box partition 
    153       INTEGER :: ishape(4)      ! Shape of arrays passed to PSMILe.  
     166      INTEGER :: ishape(4)      ! Shape of 2D arrays passed to PSMILe.  
    154167                                ! Redundant from OASIS3-MCT vn4.0 onwards but required 
    155                                 ! to satisfy interface and for backward compatibility.  
     168                                ! to satisfy interface and for backward compatibility. 
     169      INTEGER :: ishape0d1d(2)  ! Shape of 0D or 1D arrays passed to PSMILe. 
    156170      INTEGER :: var_nodims(2)  ! Number of coupling field dimensions. 
    157171                                ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 
     
    195209      ishape(4) = nlej-nldj+1 
    196210 
     211      ishape0d1d(1) = 0 
     212      ishape0d1d(2) = 0 
    197213 
    198214      ! 
     
    222238       
    223239      CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 
     240 
     241      ! A special partition is needed for 0D fields 
     242      
     243      paral(1) = 0                                       ! serial partitioning 
     244      paral(2) = 0    
     245      IF ( nproc == 0) THEN 
     246         paral(3) = 1                   ! Size of array to couple (scalar) 
     247      ELSE 
     248         paral(3) = 0                   ! Dummy size for PE's not involved 
     249      END IF 
     250      paral(4) = 0 
     251      paral(5) = 0 
     252         
     253      CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 
     254 
     255      ! Another partition is needed for 1D river routing fields 
     256       
     257      paral(1) = 0                                       ! serial partitioning 
     258      paral(2) = 0    
     259      IF ( nproc == 0) THEN 
     260         paral(3) = nn_cpl_river                   ! Size of array to couple (vector) 
     261      ELSE 
     262         paral(3) = 0                   ! Dummy size for PE's not involved 
     263      END IF 
     264      paral(4) = 0 
     265      paral(5) = 0 
     266 
     267 
     268      CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 
     269  
    224270      ! 
    225271      ! ... Announce send variables.  
     
    306352#endif 
    307353                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
    308  
    309                   ! ... Set the field dimension and bundle count 
    310                   var_nodims(1) = 2 
    311                   var_nodims(2) = 1 ! Modify this value to cater for bundled fields.     
    312  
    313                   CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , var_nodims,   & 
    314                      &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     354                  flush(numout) 
     355 
     356                  ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 
     357                  IF (srcv(ji)%dimensions <= 1) THEN 
     358                    var_nodims(1) = 1 
     359                    var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 
     360                    IF (nproc == 0) THEN 
     361 
     362                       IF (srcv(ji)%dimensions == 0) THEN 
     363 
     364                          ! If 0D then set temporary variables to 0D components 
     365                          id_part_temp = id_part_0d 
     366                          ishape0d1d(2) = 1 
     367                       ELSE 
     368 
     369                          ! If 1D then set temporary variables to river outflow components 
     370                          id_part_temp = id_part_rnf_1d 
     371                          ishape0d1d(2)= nn_cpl_river 
     372 
     373                       END IF 
     374 
     375                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp   , var_nodims,   & 
     376                                   OASIS_In           , ishape0d1d(1:2) , OASIS_REAL, nerror ) 
     377                    ELSE 
     378                       ! Dummy call to keep OASIS3-MCT happy. 
     379                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d   , var_nodims,   & 
     380                                   OASIS_In           , ishape0d1d(1:2) , OASIS_REAL, nerror ) 
     381                    END IF 
     382                  ELSE 
     383                    ! It's a "normal" 2D (or pseudo 3D) coupling field.  
     384                    ! ... Set the field dimension and bundle count 
     385                    var_nodims(1) = 2 
     386                    var_nodims(2) = 1 ! Modify this value to cater for bundled fields.      
     387 
     388                    CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , var_nodims,   & 
     389                                         OASIS_In           , ishape , OASIS_REAL, nerror ) 
     390                  ENDIF 
     391 
    315392                  IF ( nerror /= OASIS_Ok ) THEN 
    316393                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     
    412489                
    413490               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    414                   &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     491                &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    415492                
    416493               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     
    437514                     WRITE(numout,*) '****************' 
    438515                  ENDIF 
    439                    
     516 
    440517               ENDIF 
    441                 
     518 
    442519            ENDIF 
    443520             
     
    451528      ! 
    452529   END SUBROUTINE cpl_rcv 
     530 
     531   SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 
     532      !!--------------------------------------------------------------------- 
     533      !!              ***  ROUTINE cpl_rcv_1d  *** 
     534      !! 
     535      !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 
     536      !! receipt of 0D or 1D fields.  
     537      !! The fields are recieved into a 1D array buffer which is simply a  
     538      !! dynamically sized sized array (which may be of size 1) 
     539      !! of 0 dimensional fields. This allows us to pass miltiple 0D  
     540      !! fields via a single put/get operation.   
     541      !!---------------------------------------------------------------------- 
     542      INTEGER , INTENT(in   ) ::   nitems      ! Number of 0D items to recieve  
     543                                               ! during this get operation. i.e. 
     544                                               ! The size of the 1D array in which 
     545                                               ! 0D items are passed.    
     546      INTEGER , INTENT(in   ) ::   kid         ! ID index of the incoming 
     547                                               ! data.   
     548      INTEGER , INTENT(in   ) ::   kstep       ! ocean time-step in seconds 
     549      REAL(wp), INTENT(inout) ::   pdata(1:nitems) ! The original value(s),   
     550                                                   ! unchanged if nothing is  
     551                                                   ! received 
     552      INTEGER , INTENT(  out) ::   kinfo       ! OASIS3 info argument 
     553      !!  
     554      REAL(wp) ::   recvfld(1:nitems)          ! Local receive field buffer 
     555      INTEGER  ::   jc,jm     ! local loop index 
     556      INTEGER  ::   ierr 
     557      LOGICAL  ::   llaction 
     558      INTEGER  ::   MPI_WORKING_PRECISION 
     559      INTEGER  ::   number_to_print  
     560      !!-------------------------------------------------------------------- 
     561      ! 
     562      ! receive local data from OASIS3 on every process 
     563      ! 
     564      kinfo = OASIS_idle 
     565      ! 
     566      ! 0D and 1D fields won't have categories or any other form of "pseudo level"  
     567      ! so we only cater for a single set of values and thus don't bother  
     568      ! with a loop over the jc index  
     569      jc = 1 
     570 
     571      DO jm = 1, srcv(kid)%ncplmodel 
     572 
     573         IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     574 
     575            IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 
     576               ! Since there is no concept of data decomposition for zero  
     577               ! dimension fields, they must only be exchanged through the master PE,  
     578               ! unlike "normal" 2D field cases where every PE is involved.  
     579 
     580               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )    
     581                
     582               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     583                           kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     584                
     585               IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 
     586                                     llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     587                
     588               IF ( llaction ) THEN 
     589                   
     590                  kinfo = OASIS_Rcv 
     591                  pdata(1:nitems) = recvfld(1:nitems)  
     592                   
     593                  IF ( ln_ctl ) THEN         
     594                     number_to_print = 10 
     595                     IF ( nitems < number_to_print ) number_to_print = nitems 
     596                     WRITE(numout,*) '****************' 
     597                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     598                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm) 
     599                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
     600                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
     601                     WRITE(numout,*) '     - Minimum Value is ', MINVAL(pdata(:)) 
     602                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:)) 
     603                     WRITE(numout,*) '     - Start of data is ', pdata(1:number_to_print) 
     604                     WRITE(numout,*) '****************' 
     605                  ENDIF 
     606                   
     607               ENDIF 
     608            ENDIF    
     609          ENDIF 
     610             
     611       ENDDO 
     612        
     613       ! Set the precision that we want to broadcast using MPI_BCAST 
     614       SELECT CASE( wp ) 
     615       CASE( sp )  
     616         MPI_WORKING_PRECISION = MPI_REAL                ! Single precision 
     617       CASE( dp ) 
     618         MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION    ! Double precision 
     619       CASE default 
     620         CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 
     621       END SELECT 
     622 
     623       ! We have to broadcast (potentially) received values from PE 0 to all  
     624       ! the others. If no new data has been received we're just  
     625       ! broadcasting the existing values but there's no more efficient way  
     626       ! to deal with that w/o NEMO adopting a UM-style test mechanism 
     627       ! to determine active put/get timesteps.  
     628       CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_opa, ierr ) 
     629 
     630      ! 
     631   END SUBROUTINE cpl_rcv_1d 
    453632 
    454633 
     
    564743   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
    565744      CHARACTER(*), INTENT(in   ) ::  cd1 
    566       INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     745      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(*),k6 
    567746      INTEGER     , INTENT(  out) ::  k1,k7 
    568747      k1 = -1 ; k7 = -1 
     
    584763   END SUBROUTINE oasis_put 
    585764 
    586    SUBROUTINE oasis_get(k1,k2,p1,k3) 
     765   SUBROUTINE oasis_get_1d(k1,k2,p1,k3) 
     766      REAL(wp), DIMENSION(:)  , INTENT(  out) ::  p1 
     767      INTEGER                 , INTENT(in   ) ::  k1,k2 
     768      INTEGER                 , INTENT(  out) ::  k3 
     769      p1(1) = -1. ; k3 = -1 
     770      WRITE(numout,*) 'oasis_get_1d: Error you sould not be there...' 
     771   END SUBROUTINE oasis_get_1d 
     772 
     773   SUBROUTINE oasis_get_2d(k1,k2,p1,k3) 
    587774      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
    588775      INTEGER                 , INTENT(in   ) ::  k1,k2 
    589776      INTEGER                 , INTENT(  out) ::  k3 
    590777      p1(1,1) = -1. ; k3 = -1 
    591       WRITE(numout,*) 'oasis_get: Error you sould not be there...' 
    592    END SUBROUTINE oasis_get 
     778      WRITE(numout,*) 'oasis_get_2d: Error you sould not be there...' 
     779   END SUBROUTINE oasis_get_2d 
    593780 
    594781   SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r9321 r10269  
    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            ! 1D river runoff 
     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) 
     179 
    177180   TYPE ::   DYNARR      
    178181      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     
    253256      NAMELIST/namsbc_cpl/  sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro,                        & 
    254257         &                  sn_rcv_atm_pco2, sn_rcv_atm_dust 
     258 
    255259 
    256260      !!--------------------------------------------------------------------- 
     
    324328         WRITE(numout,*)'  rn_antarctica_calving_fraction      = ', rn_antarctica_calving_fraction 
    325329         WRITE(numout,*)'  rn_iceshelf_fluxes_tolerance        = ', rn_iceshelf_fluxes_tolerance 
     330 
    326331      ENDIF 
    327332 
     
    339344 
    340345      ! default definitions of srcv 
    341       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
     346      srcv(:)%laction = .FALSE. 
     347      srcv(:)%clgrid = 'T' 
     348      srcv(:)%nsgn = 1. 
     349      srcv(:)%nct = 1 
     350      srcv(:)%dimensions = 2 
    342351 
    343352      !                                                      ! ------------------------- ! 
     
    460469      !                                                      ! ------------------------- ! 
    461470      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    462       IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    463          srcv(jpr_rnf)%laction = .TRUE. 
     471      srcv(jpr_rnf_1d   )%clname = 'ORunff1D' 
     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 
    464478         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
    465479         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     
    468482      ENDIF 
    469483      ! 
    470       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    471       srcv(jpr_grnm  )%clname = 'OGrnmass'   ;   IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' )   srcv(jpr_grnm)%laction = .TRUE. 
    472       srcv(jpr_antm  )%clname = 'OAntmass'   ;   IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' )   srcv(jpr_antm)%laction = .TRUE. 
     484      srcv(jpr_cal   )%clname = 'OCalving'    
     485      IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.      
     486 
     487      srcv(jpr_grnm  )%clname = 'OGrnmass'  
     488      IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' .OR. TRIM( sn_rcv_grnm%cldes ) == 'coupled0d' ) srcv(jpr_grnm)%laction = .TRUE.         
     489      IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled0d' ) srcv(jpr_grnm  )%dimensions = 0 ! Scalar field 
     490       
     491      srcv(jpr_antm  )%clname = 'OAntmass' 
     492      IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' .OR. TRIM( sn_rcv_antm%cldes ) == 'coupled0d' )  srcv(jpr_antm)%laction = .TRUE. 
     493      IF( TRIM( sn_rcv_antm%cldes ) == 'coupled0d' ) srcv(jpr_antm  )%dimensions = 0 ! Scalar field    
     494       
    473495 
    474496 
     
    657679         ENDIF 
    658680      ENDIF 
    659        
    660       ! =================================================== ! 
    661       ! Allocate all parts of frcv used for received fields ! 
    662       ! =================================================== ! 
    663       DO jn = 1, jprcv 
    664          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    665       END DO 
    666       ! Allocate taum part of frcv which is used even when not received as coupling field 
    667       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    668       ! Allocate w10m part of frcv which is used even when not received as coupling field 
    669       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    670       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    671       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    672       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    673       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    674       IF( k_ice /= 0 ) THEN 
    675          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    676          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    677       END IF 
    678681 
    679682      ! ================================ ! 
     
    683686      !                 define send or not from the namelist parameters (ssnd(:)%laction) 
    684687      !                 define the north fold type of lbc               (ssnd(:)%nsgn) 
    685        
     688 
    686689      ! default definitions of nsnd 
    687       ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
    688           
     690      ssnd(:)%laction = .FALSE. 
     691      ssnd(:)%clgrid = 'T' 
     692      ssnd(:)%nsgn = 1. 
     693      ssnd(:)%nct = 1 
     694      ssnd(:)%dimensions = 2 
     695 
    689696      !                                                      ! ------------------------- ! 
    690697      !                                                      !    Surface temperature    ! 
     
    942949         ENDIF 
    943950      ENDIF 
     951       
     952      ! Initialise 1D river outflow scheme  
     953      nn_cpl_river = 1  
     954      IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init   ! Coupled runoff using 1D array 
     955 
     956      ! =================================================== ! 
     957      ! Allocate all parts of frcv used for received fields ! 
     958      ! =================================================== ! 
     959      DO jn = 1, jprcv 
     960 
     961         IF ( srcv(jn)%laction ) THEN  
     962            SELECT CASE( srcv(jn)%dimensions ) 
     963            ! 
     964            CASE( 0 )   ! Scalar field 
     965               ALLOCATE( frcv(jn)%z3(1,1,1) ) 
     966                
     967            CASE( 1 )   ! 1D field 
     968               ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 
     969                
     970            CASE DEFAULT  ! 2D (or pseudo 3D) field. 
     971               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     972                
     973            END SELECT 
     974         END IF 
     975 
     976      END DO 
     977      ! Allocate taum part of frcv which is used even when not received as coupling field 
     978      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     979      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     980      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     981      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     982      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     983      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     984      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
     985      IF( k_ice /= 0 ) THEN 
     986         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     987         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     988      END IF 
    944989 
    945990      ! 
     
    10731118      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
    10741119      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
    1075          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
     1120         IF( srcv(jn)%laction ) THEN  
     1121 
     1122            IF ( srcv(jn)%dimensions <= 1 ) THEN 
     1123               CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 
     1124            ELSE 
     1125               CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
     1126            END IF 
     1127 
     1128         END IF 
    10761129      END DO 
    1077  
    10781130      !                                                      ! ========================= ! 
    10791131      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  ! 
     
    13781430 
    13791431      IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
    1380          greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 
    1381          ! take average over ocean points of input array to avoid cumulative error over time 
    1382          ! The following must be bit reproducible over different PE decompositions 
    1383          zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 
    1384  
    1385          zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 
     1432          
     1433         IF( srcv(jpr_grnm)%dimensions == 0 ) THEN 
     1434       
     1435           ! This is a zero dimensional, single value field.  
     1436           zgreenland_icesheet_mass_in =  frcv(jpr_grnm)%z3(1,1,1) 
     1437            
     1438         ELSE 
     1439          
     1440           greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1)  
     1441           ! take average over ocean points of input array to avoid cumulative error over time  
     1442           ! The following must be bit reproducible over different PE decompositions  
     1443           zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) )   
     1444           zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum  
     1445            
     1446         END IF 
     1447 
    13861448         greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt          
    13871449 
     
    14151477      !                                                        ! land ice masses : Antarctica 
    14161478      IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
    1417          antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 
    1418          ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 
    1419          ! The following must be bit reproducible over different PE decompositions 
    1420          zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 
    1421  
    1422          zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 
     1479       
     1480         IF( srcv(jpr_antm)%dimensions == 0 ) THEN 
     1481          
     1482           ! This is a zero dimensional, single value field.  
     1483           zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 
     1484            
     1485         ELSE 
     1486          
     1487           antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1)  
     1488           ! take average over ocean points of input array to avoid cumulative error from rounding errors over time  
     1489           ! The following must be bit reproducible over different PE decompositions  
     1490           zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) )   
     1491           zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum  
     1492            
     1493         END IF 
     1494 
    14231495         antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt          
    14241496 
     
    18211893      ! --- runoffs (included in emp later on) --- ! 
    18221894      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1895      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    18231896 
    18241897      ! --- calving (put in emp_tot and emp_oce) --- ! 
     
    18581931      ! runoffs and calving (put in emp_tot) 
    18591932      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1933      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    18601934      IF( iom_use('hflx_rnf_cea') )   & 
    18611935         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
Note: See TracChangeset for help on using the changeset viewer.